perm filename LINE.FND[SYS,HE]1 blob sn#056756 filedate 1973-08-05 generic text, type T, neo UTF8
00100	
00200	⊃ Here we declare some arrays that are used by several procedures
00300		and some parameters which are set in INITIAL;
00400	
00500	
00600	
00700	SHORT INTEGER ARRAY HIST[-5:510];
00800	SHORT REAL ARRAY PEAKS[0:30];
00900	DEFINE LINEPTS(I) = { EDGES[EDGE_LIMIT-(I)] };
01000	SHORT REAL THFACTOR,CFACTOR,NDC2,NDTH2,NDS3,NDS32;
01100	SHORT INTEGER NMIN,NPEAKS,NHUMPS,NVERT,MINHUMPS,RMAX;
01200	SHORT INTEGER MAXRES,MINRES,NHIGH_1,FLAG;
01300	SHORT INTEGER MAXT,MAXC,MAXR,MAXDR,RHIGH,BIT_FACTOR;
01400	SHORT INTEGER INDEX, EI, L_INDEX, F_INDEX, LINE_INDEX;
01500	SHORT REAL NDRAD,NDRSQ;
01600	
01700	
01800	
01900	DEFINE	PTH =EDGE_TH -EBS+1, PC=EDGE_C -EBS+1,
02000		 POPX=EDGE_X-EBS+1, POPY=EDGE_Y-EBS+1;
02100	
02200	 	DEFINE PI32={(1.5*PI1)};
02300	
02400	DEFINE FPOINT={20},THET={1},CEE={2},SIGNX={11},SIGNY={12},
02500	CHIVALUE={7},VERTGAP={10},
02600	 VERT_END=FPOINT-2, DIRSIN=FPOINT-1, DIRCOS=FPOINT;
02700	
02800	
02900	SIMPLE INTEGER PROCEDURE SIGN(REAL X);
03000	RETURN(X/ABS(X));
03100	
03200	
03300	
03400	
03500	SIMPLE REAL PROCEDURE GET_ANGLE(SHORT REAL CX,CY);
03600	
03700	⊃ Here we return the angle defined by delta-x and delta-y;
03800	
03900	BEGIN
04000		SHORT REAL PHI;
04100	     		IF ABS(CX) ≥.10@-8  THEN
04200			BEGIN 
04300				PHI ← ATAN(CY/CX);
04400				IF CX<0 THEN PHI←PHI+PI1;
04500			END  ELSE
04600			IF CY≥0 THEN PHI ← PIO2 ELSE PHI ← -PIO2;
04700			RETURN(PHI);
04800	END;
04900	
05000	
05100	
05200	SIMPLE REAL PROCEDURE LINE_INT(REAL SINTH1,COSTH1,C1,SINTH2,COSTH2,C2;
05300				REFERENCE REAL X,Y);
05400	BEGIN 
05500		X←(C2*SINTH1-C1*SINTH2)/(COSTH1*SINTH2-SINTH1*COSTH2);
05600		Y←(C2*COSTH1-C1*COSTH2)/(SINTH1*COSTH2-COSTH1*SINTH2);
05700	END "LINE_INT";
05800	
05900	
06000	SIMPLE REAL PROCEDURE XINTERSECT(SHORT REAL X; SHORT INTEGER L);
06100	IF ABS(HUMPS[L,SINTHETA])<.10@-6 THEN RETURN(-1000.) ELSE
06200	RETURN(-(X*HUMPS[L,COSTHETA]+HUMPS[L,CEE])/HUMPS[L,SINTHETA]);
06300	
06400	
06500	
06600	SIMPLE REAL PROCEDURE YINTERSECT(SHORT REAL Y; SHORT INTEGER L);
06700	IF ABS(HUMPS[L,COSTHETA])<.10@-6 THEN RETURN(-1000.) ELSE
06800	RETURN(-(Y*HUMPS[L,SINTHETA]+HUMPS[L,CEE])/HUMPS[L,COSTHETA]);
06900	
07000	
07100	SIMPLE BOOLEAN PROCEDURE CIR_INTERSECT(REFERENCE REAL XX1,XX2;
07200			SHORT REAL Y,XC,YC,RAD);
07300	BEGIN
07400	SHORT REAL TEMP;
07500		IF (TEMP←RAD*RAD-(Y-YC)↑2)<0 THEN RETURN(0);
07600		TEMP←SQRT(TEMP);
07700		XX2←XC+TEMP;
07800		XX1←XC-TEMP;
07900		RETURN(-1);
08000	END;
08100	
08200	
08300	SIMPLE BOOLEAN PROCEDURE ARC_INTERSECT(REFERENCE REAL XX1,XX2;
08400			SHORT REAL Y,XC,YC,RAD,THETA_1,THETA_2);
08500	BEGIN
08600	SHORT REAL TEMP,THETA;
08700		IF (TEMP←RAD*RAD-(Y-YC)↑2)<0 THEN RETURN(0);
08800		TEMP←SQRT(TEMP);
08900		XX2←XC+TEMP;
09000		XX1←XC-TEMP;
09100		THETA←GET_ANGLE(XC-XX1,YC-Y);
09200		IF THETA<THETA_1 THEN THETA←THETA+PIT2;
09300		IF THETA>THETA_2 THEN
09400		BEGIN
09500	 		THETA←THETA-PIT2;
09600			IF THETA<THETA_1 THEN XX1←-1;
09700		END;
09800		THETA←GET_ANGLE(XC-XX2,YC-Y);
09900		IF THETA<THETA_1 THEN THETA←THETA+PIT2;
10000		IF THETA>THETA_2 THEN
10100		BEGIN
10200	 		THETA←THETA-PIT2;
10300			IF THETA<THETA_1 THEN XX2←-1;
10400		END;
10500		IF XX1<0∧XX2<0 THEN RETURN(0);
10600		IF XX1<0 THEN XX1←XX2;
10700		RETURN(-1);
10800	END;
10900	
     

00100	
00200	
00300	SIMPLE PROCEDURE PUT_IN_ORDER(SHORT REAL ARRAY XX; SHORT INTEGER MAX);
00400	
00500	⊃ Here we put the numbers in array XX in increasing order;
00600	
00700	BEGIN
00800	SHORT INTEGER I,ISAVE,LOWEST;
00900	SHORT REAL MIN;
01000	LABEL AGAIN;
01100		LOWEST←1;
01200	AGAIN:	MIN←10000.;  
01300	      	FOR I←LOWEST STEP 1 UNTIL MAX DO
01400		IF XX[I]<MIN THEN
01500		BEGIN
01600			MIN←XX[I];
01700			ISAVE←I;
01800		END;
01900		XX[ISAVE]↔XX[LOWEST];
02000		LOWEST←LOWEST+1;
02100		IF LOWEST<MAX THEN GO TO AGAIN;
02200	END;
02300	
02400	
02500	
02600	SIMPLE REAL PROCEDURE SMALLER(REAL L1,L2);
02700	IF L1<L2 THEN RETURN(L1) ELSE RETURN(L2);
02800	
02900	SIMPLE REAL PROCEDURE LARGER(REAL L1,L2);
03000	IF L1>L2 THEN RETURN(L1) ELSE RETURN(L2);
03100	
03200	
03300	SIMPLE REAL PROCEDURE SMALLEST(SHORT REAL X1,X2,X3);
03400	IF X1≤X2∧X1≤X3 THEN RETURN(X1) ELSE
03500	IF X2≤X1∧X2≤X3 THEN RETURN(X2) ELSE
03600	RETURN(X3);
03700	
03800	
03900	
04000	SIMPLE REAL PROCEDURE LARGEST(SHORT REAL X1,X2,X3);
04100	IF X1≥X2∧X1≥X3 THEN RETURN(X1) ELSE
04200	IF X2≥X1∧X2≥X3 THEN RETURN(X2) ELSE
04300	RETURN(X3);
04400	
04500	
04600	
04700	SIMPLE REAL PROCEDURE LENGTHSQ(SHORT INTEGER N);
04800	RETURN((HUMPS[N,FPOINT+1]-HUMPS[N,HUMPS[N,6]+1])↑2
04900		+(HUMPS[N,FPOINT+2]-HUMPS[N,HUMPS[N,6]+2])↑2);
05000	
05100	DEFINE INTERSECT(L,K)= {LINE_INT(HUMPS[L,SINTHETA],HUMPS[L,COSTHETA],
05200		HUMPS[L,CEE],HUMPS[K,SINTHETA],HUMPS[K,COSTHETA],
05300			HUMPS[K,CEE],X,Y)};
05400	
05500	
     

00100	
00200	
00300	
00400	BOOLEAN PROCEDURE VERT_THREE(SHORT INTEGER N,J1,J2;
00500			REFERENCE REAL X,Y,VERT_GAP);
00600	
00700	⊃ Here we see if the 3 lines N, J1, J2 form a vertex. In either 
00800		case we return the location X,Y, and the largest perpendicular
00900		distance of a line from the intersection point;
01000	
01100	BEGIN "VER"
01200	SHORT INTEGER I;
01300	SHORT REAL DN,DJ1,DJ2,SUMSINSQ,SUMCOSSQ,SUMSINCOS,SUMCSIN,SUMCCOS,DEN;
01400	
01500	SUMSINSQ←SUMCOSSQ←SUMSINCOS←SUMCSIN←SUMCCOS←0;
01600	FOR I←N,J1,J2 DO
01700	BEGIN
01800		SUMSINSQ←SUMSINSQ+HUMPS[I,SINTHETA]↑2;
01900		SUMCOSSQ←SUMCOSSQ+HUMPS[I,COSTHETA]↑2;
02000		SUMSINCOS←SUMSINCOS+HUMPS[I,SINTHETA]*HUMPS[I,COSTHETA];
02100		SUMCCOS←SUMCCOS+HUMPS[I,CEE]*HUMPS[I,COSTHETA];
02200		SUMCSIN←SUMCSIN+HUMPS[I,CEE]*HUMPS[I,SINTHETA];
02300	END;
02400		DEN←SUMSINCOS↑2-SUMCOSSQ*SUMSINSQ;
02500		X←(SUMSINSQ*SUMCCOS-SUMSINCOS*SUMCSIN)/DEN;
02600		Y←(SUMCOSSQ*SUMCSIN-SUMSINCOS*SUMCCOS)/DEN;
02700		DN←ABS(X*HUMPS[N,COSTHETA]+Y*HUMPS[N,SINTHETA]+HUMPS[N,CEE]);
02800		DJ1←ABS(X*HUMPS[J1,COSTHETA]+Y*HUMPS[J1,SINTHETA]+HUMPS[J1,CEE]);
02900		DJ2←ABS(X*HUMPS[J2,COSTHETA]+Y*HUMPS[J2,SINTHETA]+HUMPS[J2,CEE]);
03000		VERT_GAP←LARGEST(DN,DJ1,DJ2);
03100		IF VERT_GAP>NDACC THEN RETURN(0) ELSE RETURN(-1);
03200	END "VER";
03300	
03400	
     

00100	
00200	PROCEDURE ORDER(SHORT INTEGER F);
00300	BEGIN "ORD"
00400	SHORT REAL MIN,TEMP;
00500	SHORT INTEGER I,J,ISAVE,MAX,XY,LOWEST;
00600	LABEL AGAIN;
00700	IF ABS(HUMPS[F,9])>0.5 THEN XY←0 ELSE XY←1;
00800		MAX←HUMPS[F,6]+1; LOWEST←FPOINT+1;
00900	⊃  OUTSTR(CRLF"XY="&CVS(XY)&"  MAX="&CVS(MAX)&" LOWEST="&CVS(LOWEST)
01000		&"  SIN="&CVG(HUMPS[F,9]));
01100	
01200	   FOR I←1 STEP 1 UNTIL HUMPS[F,6]+4 DO
01300	⊃  OUTSTR(CRLF&"  I="&CVS(I)&"  HUMPS[F,I]="&CVG(HUMPS[F,I]));
01400	AGAIN: MIN←10000.;
01500		FOR I←LOWEST STEP 3 UNTIL MAX DO
01600		IF HUMPS[F,I+XY]<MIN THEN
01700		BEGIN
01800			ISAVE←I;
01900			MIN←HUMPS[F,I+XY];
02000		END;
02100		IF ISAVE≠LOWEST THEN
02200		FOR J←0 STEP 1 UNTIL 2 DO
02300		BEGIN
02400			TEMP←HUMPS[F,ISAVE+J];
02500			HUMPS[F,ISAVE+J]←HUMPS[F,LOWEST+J];
02600			HUMPS[F,LOWEST+J]←TEMP;
02700		END;
02800		LOWEST←LOWEST+3;
02900		IF LOWEST<MAX THEN GO TO AGAIN;
03000	⊃  FOR I←1 STEP 1 UNTIL HUMPS[F,6]+4 DO
03100	⊃  OUTSTR(CRLF&"  I="&CVS(I)&"  HUMPS[F,I]="&CVG(HUMPS[F,I]));
03200	END "ORD";
03300	
     

00100	
00200	
00300	SIMPLE PROCEDURE LINE_DISP(INTEGER N);
00400	
00500	⊃ Here we display line "N" which is stored in array humps. Also an arrow
00600		and  "L(N) are displayed;
00700	
00800	BEGIN "LDISP"
00900	SHORT REAL X1,Y1,X2,Y2,SINTH,COSTH,ABSIN,ABCOS,DELTA,DX,DY,GAP;
01000	SHORT REAL XC,YC,XARROW,YARROW;
01100	SHORT INTEGER JHUMP,GAPN,I,J,SGNX,SGNY;
01200	LABEL NUM_LINE;
01300		XC←(HUMPS[N,FPOINT+1]+HUMPS[N,HUMPS[N,6]+1])/2.;
01400		YC←(HUMPS[N,FPOINT+2]+HUMPS[N,HUMPS[N,6]+2])/2.;
01500		XARROW←XC; YARROW←YC;
01600		SINTH←HUMPS[N,SINTHETA];
01700	  	COSTH←HUMPS[N,COSTHETA];
01800		ABSIN←ABS(SINTH);
01900		ABCOS←ABS(COSTH);
02000		DELTA←1.3;
02100		SGNX←HUMPS[N,11];
02200		SGNY←HUMPS[N,12];
02300	⊃  OUTSTR(CRLF&"SIGN X="&CVS(SGNX)&"  SIGN Y="&CVS(SGNY));
02400		DX←SGNX*DELTA*ABSIN;
02500		DY←SGNY*DELTA*ABCOS;
02600		IF HUMPS[N,13]>0 THEN 
02700		BEGIN
02800			AIVECT(TX(HUMPS[N,13]),TY(HUMPS[N,14]));
02900			IF HUMPS[N,15]>0 THEN GO TO NUM_LINE ELSE 
03000			AVECT(TX(HUMPS[N,FPOINT+1]),TY(HUMPS[N,FPOINT+2]));
03100		END;
03200		JHUMP←FPOINT;
03300	⊃ OUTSTR(CRLF&" X="&CVG(HUMPS[N,JHUMP+1])&"  Y="&CVG(HUMPS[N,JHUMP+2]));
03400	  	AIVECT(TX(HUMPS[N,JHUMP+1]),TY(HUMPS[N,JHUMP+2]));
03500		FOR I←2 STEP 1 UNTIL HUMPS[N,5] DO
03600		BEGIN
03700			JHUMP←JHUMP+3;
03800	⊃ OUTSTR(CRLF&" X="&CVG(HUMPS[N,JHUMP+1])&"  Y="&CVG(HUMPS[N,JHUMP+2]));
03900			IF HUMPS[N,JHUMP] THEN  BEGIN
04000	 		X1←HUMPS[N,JHUMP+1]; Y1←HUMPS[N,JHUMP+2];
04100	 		AVECT(TX(X1),TY(Y1)); END
04200			ELSE
04300			BEGIN
04400				IF ABSIN>0.5 THEN
04500	 		    GAP←(HUMPS[N,JHUMP+1]-HUMPS[N,JHUMP-2])/ABSIN	
04600				ELSE
04700	 		    GAP←(HUMPS[N,JHUMP+2]-HUMPS[N,JHUMP-1])/ABCOS;
04800			    GAPN←ABS(GAP)/(2.*DELTA);
04900	⊃ OUTSTR(CRLF&" GAP = "&CVG(GAP)
05000		  &"  GAPN = "&CVS(GAPN));
05100				FOR J←1 STEP 1 UNTIL GAPN DO
05200				BEGIN
05300	⊃ OUTSTR(CRLF&"  DX="&CVG(DX)&"   DY="&CVG(DY));
05400					X1←X1+DX; Y1←Y1+DY;
05500					AIVECT(TX(X1),TY(Y1));
05600					X1←X1+DX; Y1←Y1+DY;
05700					AVECT(TX(X1),TY(Y1));
05800				END;
05900			END;
06000		END;
06100		 IF HUMPS[N,15]>0 THEN
06200	NUM_LINE:  AVECT(TX(HUMPS[N,15]),TY(HUMPS[N,16]));
06300		IF ABSIN>0.5 THEN BEGIN  YARROW←YC+3;YC←YC-4 END
06400	   		ELSE BEGIN 
06500					XARROW←XC+3; 
06600					IF CAL_COMP THEN XC←XC-16*EDGE_LIMIT/4000. 
06700					ELSE XC←XC-9;
06800			     END;
06900		AIVECT(TX(XC),TY(YC));
07000		IF CAL_COMP THEN DPYBIG(6);
07100		DPYSST("L"&CVS(N));
07200		IF ¬CAL_COMP THEN ARROW(XARROW,YARROW,DX,DY);
07300	END "LDISP";
07400	
07500	
07600	
07700	PROCEDURE SHOW;
07800	BEGIN
07900	SHORT INTEGER J;
08000		FOR J←0 STEP 1 UNTIL NHUMPS-1 DO 
08100		LINE_DISP(J);
08200		DPYOUT(1); 
08300	END "SHOW";
08400	
08500	
08600	SIMPLE PROCEDURE SHOW_LINES;
08700	BEGIN
08800	SHORT INTEGER J;
08900		DPYSET(BUF);
09000		BOUNDARY(X1,Y2,X2,Y1);
09100		FOR J←0 STEP 1 UNTIL NLINES-1 DO
09200		LINE_DISP(J);
09300		DPYOUT(1);
09400	END;
09500	
09600	PROCEDURE SHOWCIR(SHORT REAL XC,YC,NDRAD);
09700	BEGIN
09800	SHORT INTEGER J;
09900	
10000	
10100		DPYSET(BUF);
10200		BOUNDARY(X1,Y2,X2,Y1);
10300		FOR J←0 STEP 1 UNTIL NHUMPS-1 DO
10400		LINE_DISP(J);
10500		MKCIRCLE(NDRAD*SCAL,TX(XC),TY(YC),25);
10600		DPYOUT(1);
10700	END;
     

00100	
00200	
00300	⊃ Here we call the edge operator;
00400	INTEGER PROCEDURE EDGE_FIND(SHORT INTEGER X1,Y1,X2,Y2);
00500	begin "edge_find"
00600	BOOLEAN DEBUGT;
00700	SHORT REAL OP_CX,OP_CY,OP_OPX,OP_OPY,OP_OPXM,OP_OPYM,OP_OPXP,OP_OPYP;
00800	SHORT REAL OP_TM,OP_B,OP_TP;
00900	REAL C, PHI, THETA, DXY;
01000	SHORT INTEGER OP_X,OP_Y;  ⊃ POINT OF APPLICATION OF THE EDGE OPERATOR;
01100	SHORT INTEGER OP_DEBUG; ⊃ FLAG FOR OP PRINT;
01200	SHORT INTEGER nbits,nwords;
01300	
01400	SHORT INTEGER rows,columns,LIMIT;
01500	SHORT INTEGER xr,yr;
01600	SHORT INTEGER x,y,sx;
01700	LABEL LOOK1,LAST;
01800	
01900	procedure op_save;
02000	begin
02100	op_opx←opx;op_opy←opy;
02200	op_cx←cx;op_cy←cy;
02300	op_opxp←opxp;op_opxm←opxm;
02400	op_opyp←opyp;op_opym←opym;
02500	op_tm←tm;op_tp←tp;
02600	op_b←b;
02700	op_x←x;op_y←y;
02800	end;
02900	
03000	procedure op_restore;
03100	begin
03200	opx←op_opx;opy←op_opy;
03300	cx←op_cx;cy←op_cy;
03400	opxm←op_opxm;opxp←op_opxp;
03500	opym←op_opym;opyp←op_opyp;
03600	tm←op_tm;tp←op_tp;
03700	b←op_b;
03800	xr←op_x;yr←op_y;
03900	end;
04000	
04100	
04200	
04300	LOOK1:	rows←y2-y1+1;
04400		columns←x2-x1+1;
04500	⊃ OUTSTR(CRLF&"  IN EDGE_FIND  ROWS="&CVS(ROWS)&"  COLUMNS="&CVS(COLUMNS));
04600		LIMIT←EDGE_LIMIT-5*EDGE_BLSIZE;
04700		nbits←rows*columns;
04800		nwords←nbits DIV 36;
04900		EDGE_COUNT ← 1;
05000		EDGE_INDEX ← 0;
05100		if nbits MOD 36 then nwords←nwords+1;
05200	BEGIN "SHOW1"
05300			SHORT INTEGER ptr1;
05400			SHORT INTEGER_array edge_bits[1:nwords];
05500			for x←1 step 1 until nwords do edge_bits[x]←0;
05600	
05700			for y←y1+2 step 2 until y2-2 do
05800			begin "CLX"
05900				if (y land 2)≠0 then sx←x1+2
06000				else sx←x1+3;
06100	⊃ Here we start the edge scan and display the results;
06200	
06300				for x←sx step 2 until x2-2 do begin "xscan"
06400				LABEL AWAY,T1,T2,T3,T4,T5;
06500				SHORT INTEGER wd;
06600				SHORT REAL u;
06700	⊃ OUTSTR(CRLF&"  X="&CVS(X)&"  Y="&CVS(Y));
06800	T1:			if EJLI(x,y,0,0) ∧ ¬bcomp then begin "store"
06900	   			SHORT REAL v;
07000				label resume;
07100	⊃		if debugt then	
07200			outstr(crlf&" success "&cvs(x)&" "&cvs(y)&" ");
07300	T2:			v←sqrt((opx-x)↑2+(opy-y)↑2)/abs(tm+tp);
07400				xr←opx+0.5;yr←opy+0.5;
07500				if xr=x ∧ yr=y then go to resume;
07600	⊃	if debugt then	outstr(" xr "&cvs(xr)&" "&cvs(yr));
07700				op_save;
07800	T3:			if ((¬EJLI(xr,yr,0,0))∨bcomp)
07900			∨(u←((opx-xr)↑2+(opy-yr)↑2)>1.0) then op_restore
08000				else if v<sqrt(u)/abs(tm+tp)
08100					then op_restore;
08200			resume:		
08300				⊃ use a bit matrix to test whether 
08400					we have tried here before;
08500	T4:			nbits←(xr-X1)+(yr-Y1)*columns;
08600				nwords←nbits div 36;
08700				nbits←nbits mod 36;
08800				if nbits≠0 then nwords←nwords+1;
08900				nbits← 1 LSH nbits;
09000				wd←edge_bits[nwords] LAND nbits;
09100				if wd≠0∨((opx-xr)↑2+(opy-yr)↑2)>1.0 then begin
09200	⊃	if debugt then	outstr(crlf&" killed "&cvs(xr)&" "&cvs(yr)&" ");
09300				go to away;end;
09400				edge_bits[nwords]←edge_bits[nwords] LOR nbits;
09500			IF ABS(CX) ≥.10@-8  THEN
09600			BEGIN 
09700				PHI ← ATAN(CY/CX);
09800				IF CX<0 THEN PHI←PHI+PI1;
09900			END  ELSE
10000			IF CY≥0 THEN PHI ← PIO2 ELSE PHI ← -PIO2;
10100			THETA ← PHI +PI1;		
10200			C ← -OPX*COS(THETA) -OPY*SIN(THETA);
10300	⊃      	OUTSTR(CRLF&"PHI = " &CVG(PHI)
10400			 &"   X="&CVG(OPX)
10500			 &"   Y="&CVG(OPY)
10600		           &"THETA = " &CVG(THETA)
10700	    		   &"  SINTH="&CVG(SIN(THETA))
10800	    		   &"  COSTH="&CVG(COS(THETA))
10900		           &"C = " &CVG(C));
11000					edges[edge_count+edge_x]←opx;
11100					edges[edge_count+edge_y]←opy;
11200					EDGES[EDGE_COUNT+EDGE_TH]←THETA;
11300					EDGES[EDGE_COUNT+EDGE_C]←C;
11400					edge_index←edge_index+1;
11500					edge_count←edge_count+edge_blsize;
11600				end "store";
11700				IF EDGE_COUNT>LIMIT THEN RETURN(Y);
11800			away:
11900				end "xscan";
12000			end "CLX";
12100	END "SHOW1";
12200	edge_count←edge_count-edge_blsize;
12300	IF DIS_EYE THEN
12400	BEGIN
12500		EDGE_DISP(0,EDGE_INDEX,X1,Y1,X2,Y2,EDGES);
12600		DPYOUT(1);
12700		IF CAL2_COMP THEN CALCOMP("NEWEDG",BUF)
12800		ELSE IF CAL_COMP THEN CALCOMP("EDGES",BUF);
12900	END;
13000	LAST:  RETURN(-1);
13100	END "edge_find";
     

00100	⊃ Here we call the edge operator;
00200	⊃  This procedure is used to scan rectanglar regions which are
00300	 at an angle theta to the x-axis. DX = sin(theta) and DY = cos(theta),
00400	 XC and YC are the center of the small-x side before rotation;
00500	
00600	INTEGER PROCEDURE EDGE_SCAN(SHORT REAL XC,YC,DX,DY);
00700	BEGIN "SCAN_EDGE"
00800	BOOLEAN DEBUGT;
00900	SHORT REAL OP_CX,OP_CY,OP_OPX,OP_OPY,OP_OPXM,OP_OPYM,OP_OPXP,OP_OPYP;
01000	SHORT REAL OP_TM,OP_B,OP_TP;
01100	REAL C, PHI, THETA, DXY;
01200	SHORT INTEGER OP_X,OP_Y;  ⊃ POINT OF APPLICATION OF THE EDGE OPERATOR;
01300	SHORT INTEGER OP_DEBUG; ⊃ FLAG FOR OP PRINT;
01400	SHORT INTEGER nbits,nwords;
01500	SHORT INTEGER X1,Y1,X2,Y2;
01600	SHORT INTEGER rows,columns,LIMIT,MAXN;
01700	SHORT INTEGER xr,yr,INTX,INTY;
01800	SHORT REAL XP,YP,DIFFSAVE;
01900	
02000	
02100	DEFINE DPARALLEL="15", DPERP="10",DEL="0", DSTEP="1";
02200	
02300	SHORT INTEGER x,y,sx;
02400	LABEL LOOK1,LAST;
02500	
02600	procedure op_save;
02700	begin
02800	op_opx←opx;op_opy←opy;
02900	op_cx←cx;op_cy←cy;
03000	op_opxp←opxp;op_opxm←opxm;
03100	op_opyp←opyp;op_opym←opym;
03200	op_tm←tm;op_tp←tp;
03300	op_b←b;
03400	op_x←XP;op_y←YP;
03500	end;
03600	
03700	procedure op_restore;
03800	begin
03900	opx←op_opx;opy←op_opy;
04000	cx←op_cx;cy←op_cy;
04100	opxm←op_opxm;opxp←op_opxp;
04200	opym←op_opym;opyp←op_opyp;
04300	tm←op_tm;tp←op_tp;
04400	b←op_b;
04500	xr←op_x;yr←op_y;
04600	end;
04700	
04800		DIFFSAVE←DIFF;
04900		DIFF←10.;
05000	
05100		X1←XC-DY*DPERP/2.;
05200		Y1←YC+DX*DPERP/2.;
05300		X2←X1-DPARALLEL*DX+DPERP*DY;
05400		Y2←Y1-DPARALLEL*DY-DPERP*DX;
05500	⊃ OUTSTR(CRLF&" X1="&CVG(X1)&
05600	            " X2="&CVG(X2)&
05700	            " Y1="&CVG(Y1)&
05800	            " Y2="&CVG(Y2)&
05900		    "  DX="&CVG(DX)&
06000		   "   DY="&CVG(DY)ACRLF);
06100	LOOK1:	ROWS←DPERP+1;
06200		COLUMNS←DPARALLEL+1;
06300	⊃ OUTSTR(CRLF&"  IN EDGE_FIND  ROWS="&CVS(ROWS)&"  COLUMNS="&CVS(COLUMNS));
06400		LIMIT←EDGE_LIMIT-5*EDGE_BLSIZE;
06500		nbits←rows*columns;
06600		nwords←nbits DIV 36;
06700		MAXN←NWORDS;
06800		EDGE_COUNT ← 1;
06900		EDGE_INDEX ← 0;
07000		if nbits MOD 36 then nwords←nwords+1;
07100	BEGIN "SHOW1"
07200			SHORT INTEGER ptr1;
07300			SHORT INTEGER ARRAY EDGE_BITS[-5:MAXN+10];
07400			for x←0 step 1 until nwords do edge_bits[x]←0;
07500	
07600			FOR Y←DEL STEP DSTEP  UNTIL DPERP-DEL DO
07700			begin "CLX"
07800	⊃ Here we start the edge scan and display the results;
07900	
08000				FOR X←DEL STEP DSTEP UNTIL DPARALLEL-DEL DO 
08100				BEGIN "XSCAN"
08200				LABEL AWAY,T1,T2,T3,T4,T5,SAV;
08300				SHORT INTEGER wd;
08400				SHORT REAL u;
08500				XP←X1-X*DX+Y*DY;
08600				YP←Y1-X*DY-Y*DX;
08700	⊃ OUTSTR(CRLF&"  X="&CVS(X)&"  Y="&CVS(Y)&"  XP="&CVG(XP)&"  YP="&CVG(YP));
08800	T1:			IF EJLI(XP,YP,0,0) ∧ ¬BCOMP THEN 
08900				begin "store"
09000	   			SHORT REAL v;
09100				label resume;
09200	⊃		if debugt then	
09300			outstr(crlf&" success "&cvs(XP)&" "&cvs(YP)&" ");
09400	T2:			v←sqrt((opx-XP)↑2+(opy-YP)↑2)/abs(tm+tp);
09500				xr←opx+0.5;yr←opy+0.5;
09600				if xr=XP ∧ yr=YP then go to resume;
09700	 ⊃                     	outstr(CRLF&" xr "&cvs(xr)&" "&cvs(yr));
09800				op_save;
09900	T3:			if ((¬EJLI(xr,yr,0,0))∨bcomp)
10000			∨(u←((opx-xr)↑2+(opy-yr)↑2)>1.0) then op_restore
10100				else if v<sqrt(u)/abs(tm+tp)
10200					then op_restore;
10300			resume:		
10400				⊃ use a bit matrix to test whether 
10500					we have tried here before;
10600	T4:			INTX←-DX*(XR-X1)-DY*(YR-Y1);
10700				INTY←DY*(XR-X1)-DX*(YR-Y1);
10800				NBITS←INTX+INTY*COLUMNS;
10900				nwords←nbits div 36;
11000				nbits←nbits mod 36;
11100				if nbits≠0 then nwords←nwords+1;
11200				nbits← 1 LSH nbits;
11300				IF NWORDS<0∨NWORDS>MAXN THEN GO TO SAV;
11400				wd←edge_bits[nwords] LAND nbits;
11500				if wd≠0∨((opx-xr)↑2+(opy-yr)↑2)>1.0 then begin
11600	⊃	if debugt then	outstr(crlf&" killed "&cvs(xr)&" "&cvs(yr)&" ");
11700				go to away;end;
11800				edge_bits[nwords]←edge_bits[nwords] LOR nbits;
11900	SAV:		IF ABS(CX) ≥.10@-8  THEN
12000			BEGIN 
12100				PHI ← ATAN(CY/CX);
12200				IF CX<0 THEN PHI←PHI+PI1;
12300			END  ELSE
12400			IF CY≥0 THEN PHI ← PIO2 ELSE PHI ← -PIO2;
12500			THETA ← PHI +PI1;		
12600			C ← -OPX*COS(THETA) -OPY*SIN(THETA);
12700	⊃      	OUTSTR(CRLF&"PHI = " &CVG(PHI)
12800			 &"   X="&CVG(OPX)
12900			 &"   Y="&CVG(OPY)
13000		           &"THETA = " &CVG(THETA)
13100	    		   &"  SINTH="&CVG(SIN(THETA))
13200	    		   &"  COSTH="&CVG(COS(THETA))
13300		           &"C = " &CVG(C));
13400					edges[edge_count+edge_x]←opx;
13500					edges[edge_count+edge_y]←opy;
13600					EDGES[EDGE_COUNT+EDGE_TH]←THETA;
13700					EDGES[EDGE_COUNT+EDGE_C]←C;
13800					edge_index←edge_index+1;
13900					edge_count←edge_count+edge_blsize;
14000				end "store";
14100				IF EDGE_COUNT>LIMIT THEN RETURN(Y);
14200			away:
14300				END "XSCAN";
14400			end "CLX";
14500	END "SHOW1";
14600	DIFF←DIFFSAVE;
14700	edge_count←edge_count-edge_blsize;
14800	IF DIS_EYE THEN
14900	BEGIN
15000		EDGE_DISP(0,EDGE_INDEX,X1,Y1,X2,Y2,EDGES);
15100		DPYOUT(1);
15200		IF CAL_COMP THEN CALCOMP("NEWEDG",BUF);
15300	END;
15400	LAST:  RETURN(-1);
15500	END "SCAN_EDGE";
     

00100	
00200	BOOLEAN PROCEDURE MAX_TEST(SHORT INTEGER JSAVE,MAXT;
00300		SHORT INTEGER ARRAY HIST);
00400	
00500	⊃ HERE WE TEST FOR A MAXIMUM (PEAK) ALONG THE THETA OR C-AXIS
00600	  HISTOGRAM. WE REQUIRE 4 ADJACENT HISTOGRAM BUCKETS TO 
00700	  CONTAIN NHIGH OR MORE EDGE-POINTS;
00800	
00900	BEGIN "MAX"
01000	
01100		IF JSAVE-3<0∨JSAVE+3>MAXT THEN RETURN(-1)
01200		ELSE
01300		IF HIST[JSAVE-2]+HIST[JSAVE-1]+HIST[JSAVE]+HIST[JSAVE+1]>NHIGH_1
01400		 ∨ HIST[JSAVE-1]+HIST[JSAVE]+HIST[JSAVE-2]+HIST[JSAVE-3]>NHIGH_1
01500		 ∨  HIST[JSAVE-1]+HIST[JSAVE+2]+HIST[JSAVE]+HIST[JSAVE+1]>NHIGH_1    	
01600		 ∨  HIST[JSAVE+3]+HIST[JSAVE+2]+HIST[JSAVE]+HIST[JSAVE+1]>NHIGH_1    
01700		THEN RETURN(-1);
01800		RETURN(0);
01900	END "MAX";
02000	
02100	
02200	
02300	BOOLEAN PROCEDURE HIST_TH;
02400	
02500	 	⊃ This procedure generates a histogram along the 
02600		THETA axis;
02700	
02800	BEGIN "HIST_TH"
02900	SHORT INTEGER I,J,JSAVE,JEND,MAX,LARGEST,LAST;
03000	SHORT REAL THETA;
03100	
03200		LAST←EDGE_INDEX*EBS;
03300		FOR I←0 STEP 1 UNTIL MAXT DO HIST[I]←0;
03400		FOR I←EDGE_BLSIZE STEP EDGE_BLSIZE UNTIL LAST DO
03500		BEGIN
03600			THETA ← EDGES[I+PTH];
03700			J ← (THETA-PIO2)*THFACTOR;
03800		⊃	IF J+1<0∨J>MAXT+1 THEN
03900			OUTSTR(CRLF&" J="&CVS(J)&"  THETA="&CVG(THETA)&
04000			"   THFACTOR="&CVG(THFACTOR));
04100			HIST[J] ← HIST[J] + 1;
04200		END;
04300		MAX ← LARGEST ← 0; JEND ←5; 
04400	⊃ HERE WE ARE LOOKING FOR PEAKS IN THE HISTOGRAM ALONG THE THETA-AXIS;
04500		FOR I←0 STEP 1 UNTIL MAXT DO	
04600		IF HIST[I]>NMIN THEN 
04700		BEGIN
04800			JSAVE←I; 
04900			MAX ← HIST[I];
05000			IF I>MAXT-5 THEN JEND←MAXT-I;
05100			FOR J←1 STEP 1 UNTIL JEND DO
05200			IF HIST[I+J]>MAX THEN 
05300			BEGIN MAX←HIST[I+J]; JSAVE←I+J; END;
05400			IF JSAVE<MAXT-3 THEN I←JSAVE+3 ELSE I←MAXT;
05500			IF LARGEST<MAX THEN LARGEST←MAX;
05600			IF HIST[JSAVE]>NHIGH∨MAX_TEST(JSAVE,MAXT,HIST) THEN     
05700			BEGIN
05800				PEAKS[NPEAKS] ← JSAVE/THFACTOR + PIO2;
05900	IF DISP_HIST THEN OUTSTR("PEAKS = "&CVS(JSAVE)&"  "&
06000				CVG(PEAKS[NPEAKS])&CRLF);
06100				NPEAKS←NPEAKS+1;
06200			END;
06300		END;
06400		IF NPEAKS=0 THEN RETURN(0);
06500		IF DISP_HIST THEN H_DISPLAY(0,1,MAXT,LARGEST,HIST);
06600		RETURN(-1);
06700	END "HIST_TH";
     

00100	
00200	BOOLEAN PROCEDURE HISTC;
00300	
00400	COMMENT THIS PROCEDURE GENERATES A HISTOGRAM ALONG THE
00500		C-AXIS FOR A GIVEN DELTA-THETA;
00600	
00700	BEGIN "HISTC"
00800	SHORT INTEGER N,II,J,I,JSAVE,JEND,MAX,LARGEST,LAST,MINHP;
00900	SHORT REAL C;
01000	LABEL B1;
01100	⊃ OUTSTR(CRLF&"NUMBER OF PEAKS = " &CVS(NPEAKS));
01200	MINHP←NHUMPS;
01300	FOR N←0 STEP 1 UNTIL NPEAKS-1 DO
01400	BEGIN
01500		LAST←EDGE_INDEX*EBS;
01600		FOR I←0 STEP 1 UNTIL MAXC DO HIST[I]←0;
01700		FOR II←EDGE_BLSIZE STEP EDGE_BLSIZE UNTIL LAST DO
01800			IF ABS(EDGES[II+PTH]-PEAKS[N])<NDTH THEN
01900			BEGIN
02000				C←EDGES[II+PC];
02100				J←(C+DXY)*CFACTOR;
02200		⊃	IF J+1<0∨J>MAXC+1 THEN
02300			OUTSTR(CRLF&" J="&CVS(J)&"  C="&CVG(C)&
02400			"   CFACTOR="&CVG(CFACTOR));
02500				HIST[J]←HIST[J]+1;
02600			END;
02700		MAX ← LARGEST ← 0; JEND ←3; 
02800	B1:	FOR I←0 STEP 1 UNTIL MAXC DO
02900		IF HIST[I]>NMIN THEN 
03000		BEGIN
03100			JSAVE←I; 
03200			MAX ← HIST[I];
03300			IF I>MAXC-3 THEN JEND←MAXC-I;
03400			FOR J←1 STEP 1 UNTIL JEND DO
03500			IF HIST[I+J]>MAX THEN 
03600			BEGIN MAX←HIST[I+J]; JSAVE←I+J; END;
03700			IF JSAVE<MAXC-3 THEN I←JSAVE+3 ELSE I←MAXC;
03800			IF LARGEST<MAX THEN LARGEST←MAX;
03900			IF HIST[JSAVE]>NHIGH∨MAX_TEST(JSAVE,MAXC,HIST) THEN 
04000			BEGIN
04100				HUMPS[NHUMPS,2] ← JSAVE/CFACTOR -DXY;
04200				HUMPS[NHUMPS,1] ← PEAKS[N];
04300	 IF DISP_HIST THEN OUTSTR("HUMPS = "&CVS(JSAVE)&"  "&
04400				CVG(HUMPS[NHUMPS,2])&"    "&
04500				CVG(HUMPS[NHUMPS,1])&CRLF);
04600				NHUMPS←NHUMPS+1;
04700			END;
04800			IF NHUMPS≥LINE_LIMIT THEN RETURN(-1);
04900		END;
05000		IF DISP_HIST THEN H_DISPLAY(0,1,MAXC,LARGEST,HIST);
05100	END;
05200	IF MINHP=NHUMPS THEN RETURN(0) ELSE RETURN(-1);
05300	END "HISTC";
     

00100	
00200	
00300	
00400	PROCEDURE SPLIT(SHORT REAL TH_AVE,C_AVE,SINTH,COSTH;
00500		SHORT REAL ARRAY LTEMP; REFERENCE SHORT REAL SUMTH,SUMC;
00600			REFERENCE SHORT INTEGER SUMN);
00700	
00800	⊃ HERE WE SPLIT THE EDGE POINTS THAT FORM 2 LINES AND WORK WITH
00900	 THE LINE THAT HAS THE MOST EDGES-POINTS BY RECENTERING TH_AVE AND C_AVE;
01000	
01100	BEGIN "SPLIT"
01200	SHORT INTEGER SUM_MINUS,PT1,PT2,I;
01300	SHORT REAL SUMTHM,SUMCM,TEMP,TEMP2,RESID;
01400	SHORT REAL OPX,OPY,CX,CY;
01500	SHORT INTEGER ARRAY BUF2[1:BUF2_LIMIT];
01600		IF DISP_POINTS THEN
01700		BEGIN
01800		DPYSET(BUF2);
01900		BOUNDARY(X1,Y2,X2,Y1);
02000		PT2←DPYPARS;
02100		DPYSET(BUF);
02200		BOUNDARY(X1,Y2,X2,Y1);
02300		PT1←DPYPARS;
02400		END;
02500		SUMN←SUM_MINUS←0;
02600		SUMTH←SUMTHM←SUMC←SUMCM←0;
02700		FOR I←EDGE_BLSIZE STEP EDGE_BLSIZE UNTIL L_INDEX*EDGE_BLSIZE DO
02800		BEGIN "MGET"
02900		TEMP←ABS(LTEMP[I+PTH]-TH_AVE); TEMP2←LTEMP[I+PTH];
03000		IF ABS(TEMP-PIT2)<NDTH THEN
03100		IF (TEMP2←LTEMP[I+PTH]-PIT2)<0 THEN TEMP2←LTEMP[I+PTH]+PIT2;
03200		IF ABS(LTEMP[I+PC]-C_AVE)<NDC
03300		∧(TEMP<NDTH∨ABS(TEMP-PIT2)<NDTH) THEN
03400		BEGIN "OUTSIDE"
03500	        IF (RESID←COSTH*LTEMP[I+POPX]+SINTH*LTEMP[I+POPY]+C_AVE)≥0 THEN
03600		BEGIN
03700			SUMN←SUMN+1;
03800			SUMTH ←SUMTH+TEMP2;
03900			SUMC←SUMC+LTEMP[I+PC];
04000			IF DISP_POINTS THEN 
04100			BEGIN
04200				DPYRESET(PT1);
04300				OPX←LTEMP[I+POPX];
04400				OPY←LTEMP[I+POPY];
04500				CY←SIN(TEMP2);
04600				CX←COS(TEMP2);
04700				DISP_EDGE;
04800				PT1←DPYPARS;
04900			END;
05000		END ELSE
05100		BEGIN
05200			SUM_MINUS←SUM_MINUS+1;
05300			SUMTHM ←SUMTHM+TEMP2;
05400			SUMCM←SUMCM+LTEMP[I+PC];
05500			IF DISP_POINTS THEN 
05600			BEGIN
05700				DPYRESET(PT2);
05800				OPX←LTEMP[I+POPX];
05900				OPY←LTEMP[I+POPY];
06000				CY←SIN(TEMP2);
06100				CX←COS(TEMP2);
06200				DISP_EDGE;
06300				PT2←DPYPARS;
06400			END;
06500		END;
06600	⊃ OUTSTR(CRLF&"RESID(SPLIT)= "&CVG(RESID)&" TH="&CVG(TEMP2)&" C="
06700	&CVG(LTEMP[I+PC]));
06800	⊃ OUTSTR(CRLF&" X="&CVG(LTEMP[I+POPX])&"  Y="&CVG(LTEMP[I+POPY]));
06900		END "OUTSIDE";  END "MGET";
07000		IF DISP_POINTS THEN 
07100		BEGIN
07200			DPYRESET(PT1);
07300			AIVECT(-300,420);
07400			DPYSST("SPLIT: NUMBER OF POSITIVE POINTS="&CVS(SUMN));
07500			DPYOUT(1);
07600			INCHWL;
07700			INCHWL;
07800			DPYRESET(PT2);
07900			AIVECT(-300,420);
08000			DPYSST("SPLIT: NUMBER OF NEGATIVE POINTS="&CVS(SUM_MINUS));
08100			DPYOUT(1);
08200			INCHWL;
08300			INCHWL;
08400			DPYCLR;
08500		END;
08600		IF SUM_MINUS>SUMN THEN
08700		BEGIN 
08800			IF SUMN>NHIGH THEN
08900			BEGIN
09000				HUMPS[NHUMPS,1]←SUMTH/SUMN;
09100				HUMPS[NHUMPS,2]←SUMC/SUMN;
09200				NHUMPS←NHUMPS+1;
09300			END;
09400		     	SUMN←SUM_MINUS; SUMTH←SUMTHM; SUMC←SUMCM; 
09500		END 
09600		ELSE
09700			IF SUM_MINUS>NHIGH THEN
09800			BEGIN
09900				HUMPS[NHUMPS,1]←SUMTHM/SUM_MINUS;
10000				HUMPS[NHUMPS,2]←SUMCM/SUM_MINUS;
10100				NHUMPS←NHUMPS+1;
10200			END;
10300	END "SPLIT";
     

00100	
00200	
00300	
00400	BOOLEAN PROCEDURE LINETEST(SHORT INTEGER N; SHORT REAL TH_AVE,C_AVE,NDTH,NDC;
00500				 SHORT REAL ARRAY LTEMP);
00600	
00700	⊃ Here we determine if there are a set of edge points in array
00800		LTEMP that form a line with THETA and C values near
00900		TH_AVE and C_AVE;
01000	
01100	BEGIN "LINETEST"
01200	SHORT INTEGER I,J,CYC,MEAN,ISAVE,K,MIN,SUMN, SUM_PLUS,SUM_MINUS;
01300	SHORT INTEGER TEST3,SAVET,IMAX,IMIN,MAX;
01400	SHORT INTEGER MAX2,ISAVE2,LOWEST;
01500	BOOLEAN TEST, GAP1_FOUND, GAP2_FOUND;
01600	STRING PTEST;
01700	SHORT REAL TEMP,TEMP2,SUMTH,SUMC,SINTH,COSTH,RESID,THETA;
01800	SHORT REAL MG_LENGTH, GAP, DEN, RESMIN, RESMAX, DTHET, DCEE;
01900	SHORT REAL CHI,TESTXY,RES;
02000	SHORT REAL CPRIME,TH_LS,C_LS,SUMX,SUMY,SUMXY,SUMXSQ,SUMYSQ,SUM_RESID;
02100	LABEL AGAIN,AFTER,AGAIN2,AGAIN3,AGAIN4,LAST1,LAST2,POOR_LINE;
02200	LABEL AVER,TLINE,PART1,PART2,PART3,FIRSTK,LASTK, BEFORE;
02300	LABEL LAS1,LAS2;
02400		TEST3←0; RESID←0; CYC←-1;
02500	BEFORE:	COSTH←COS(TH_AVE);	SINTH←SIN(TH_AVE);
02600		SUM_PLUS←SUM_MINUS←0;
02700		FOR J←0 STEP 1 UNTIL 202 DO
02800		HIST[J]←0;
02900		INDEX ← INDEX -EDGE_BLSIZE;  SAVET←0;
03000		L_INDEX ← INDEX DIV EDGE_BLSIZE;
03100	⊃ HERE WE START 2 CYCLES TO SEPARATE EDGE_POINTS BY THEIR:
03200		THETA-VALUES, C-VALUES, AND RESIDUALS;
03300	AGAIN:	CYC←CYC+1; SUMTH←0; SUMC←0; SUMN←0; SUMX←SUMY←SUMXY←0;
03400		SUMXSQ←SUMYSQ←0;
03500	AGAIN2:	FOR I←EDGE_BLSIZE STEP EDGE_BLSIZE UNTIL L_INDEX*EDGE_BLSIZE DO
03600		BEGIN "KGET"
03700		TEMP←ABS(LTEMP[I+PTH]-TH_AVE); TEMP2←LTEMP[I+PTH];
03800		IF ABS(TEMP-PIT2)<NDTH THEN
03900		IF (TEMP2←LTEMP[I+PTH]-PIT2)<0 THEN TEMP2←LTEMP[I+PTH]+PIT2;
04000		IF ABS(LTEMP[I+PC]-C_AVE)<NDC
04100		∧(TEMP<NDTH∨ABS(TEMP-PIT2)<NDTH) THEN
04200		BEGIN
04300			RES←COSTH*LTEMP[I+POPX]+SINTH*LTEMP[I+POPY]+C_AVE;
04400			IF CYC=0 THEN
04500			BEGIN
04600				IF RES>-10.∧RES<10. THEN
04700				BEGIN
04800					J←MAXDR*(RES+10.);
04900					HIST[J]←HIST[J]+1;
05000				END
05100				ELSE
05200				BEGIN
05300					IF RES<-10. THEN SUM_MINUS←SUM_MINUS+1
05400					ELSE SUM_PLUS←SUM_PLUS+1;
05500				END;
05600				GO TO LASTK;
05700			END;    
05800			IF RES<RESMIN∨RES>RESMAX THEN GO TO AFTER;
05900	⊃	OUTSTR(CRLF&"RESIDUAL="&CVG(RESID)&"  SUMN="&CVS(SUMN));
06000	FIRSTK:		SUMN←SUMN+1;
06100			SUMTH ←SUMTH+TEMP2;
06200			SUMC←SUMC+LTEMP[I+PC];
06300			SUMX←SUMX+LTEMP[I+POPX];
06400			SUMY←SUMY+LTEMP[I+POPY];
06500			SUMXY←SUMXY+LTEMP[I+POPY]*LTEMP[I+POPX];
06600			SUMXSQ←SUMXSQ+LTEMP[I+POPX]↑2;
06700			SUMYSQ←SUMYSQ+LTEMP[I+POPY]↑2;
06800	⊃ OUTSTR(CRLF&"RESIDUAL="&CVG(RESID)&
06900	        	"  X="&CVG(LTEMP[I+POPX])&
07000			"  Y="&CVG(LTEMP[I+POPY])&
07100			"  TH="&CVG(LTEMP[I+PTH])&
07200			"  C="&CVG(LTEMP[I+PC]));
07300	
07400		END ELSE
07500	 AFTER: IF CYC>0∧¬TEST3 THEN
07600	 	BEGIN
07700	⊃ NOW WE PUT THE BAD-FIT EDGE POINTS BACK IN ARRAY EDGES;
07800			EDGE_INDEX ← EDGE_INDEX +1;
07900			EI ← EDGE_INDEX*EDGE_BLSIZE;
08000			EDGES[EI+PTH] ← LTEMP[I+PTH];
08100			EDGES[EI+PC] ← LTEMP[I+PC];
08200			EDGES[EI+POPX] ← LTEMP[I+POPX];
08300	  		EDGES[EI+POPY] ← LTEMP[I+POPY];
08400			LTEMP[I+PTH]←LTEMP[INDEX+PTH];
08500			LTEMP[I+PC]←LTEMP[INDEX+PC];
08600			LTEMP[I+POPX]←LTEMP[INDEX+POPX];
08700			LTEMP[I+POPY]←LTEMP[INDEX+POPY];
08800			I ← I - EDGE_BLSIZE;
08900			L_INDEX ← L_INDEX -1;
09000			INDEX ← INDEX -EDGE_BLSIZE;
09100		END;
09200	LASTK:	END "KGET";
09300		IF CYC=0 THEN
09400		BEGIN
09500			MAX←0;
09600			FOR J←0 STEP 1 UNTIL MAXR DO
09700			IF HIST[J]>MAX THEN BEGIN MAX←HIST[J];ISAVE←J; END
09800			ELSE IF HIST[J]=MAX THEN 
09900			BEGIN MAX2←HIST[J]; ISAVE2←J; END;
10000			IF DISP_POINTS THEN H_DISPLAY(0,1,MAXR,MAX,HIST);
10100			IF MAX<RHIGH THEN GO TO POOR_LINE;
10200			IF ¬TEST3∧(ISAVE<MINRES∨ISAVE>MAXRES) THEN 
10300				TEST3←-1 ELSE TEST3←0;
10400	
10500	PART1:		FOR J←ISAVE STEP 1 UNTIL MAXR DO
10600			IF HIST[J]>0 THEN IMAX←J
10700			ELSE IF HIST[J+1]=0∧HIST[J+2]=0∧HIST[J+3]=0 THEN
10800			GO TO PART2;
10900	PART2:		FOR J←ISAVE STEP -1 UNTIL 0 DO
11000			IF HIST[J]>0 THEN IMIN←J
11100	 		ELSE IF HIST[J-1]=0∧HIST[J-2]=0∧HIST[J-3]=0 THEN
11200			GO TO PART3;
11300	PART3:		RESMIN←(IMIN-1)/MAXDR -10.;
11400			RESMAX←(IMAX+1)/MAXDR -10.;
11500			IF DISP_POINTS THEN
11600			BEGIN
11700				DPYCLR;
11800				DPYSET(BUF);
11900				AIVECT(-300,420);
12000				DPYSST("CYCLE=0  BEFORE OMITTING BAD POINTS");
12100				INIT_DOMAIN(X1,Y2,X2,Y1);
12200				BOUNDARY(X1,Y2,X2,Y1);
12300				EDGE_DISP(0,L_INDEX,X1,Y1,X2,Y2,LTEMP);
12400				DPYOUT(1);
12500				INCHWL;
12600				INCHWL;
12700				DPYCLR;
12800			END;
12900			SUMN←0;
13000			FOR J←IMIN STEP 1 UNTIL IMAX DO
13100			SUMN← SUMN+HIST[J];
13200			IF SUMN≤NHIGH∧¬TEST3 THEN 
13300			BEGIN 
13400				IF MAX2<2 THEN GO TO POOR_LINE;
13500				MAX2←0; ISAVE←ISAVE2;
13600				GO TO PART1;
13700			END;
13800			GO TO AGAIN;
13900	
14000		END;
14100	 ⊃ THIS IS USED WHEN THERE ARE TOO FEW GOOD EDGE POINTS;
14200		IF RESMAX<-900. THEN RETURN(0);
14300	AVER:	IF SUMN≤NHIGH∧¬TEST3 THEN GO TO POOR_LINE;
14400	      	TH_AVE←SUMTH/SUMN; C_AVE←SUMC/SUMN;
14500		IF TEST3 THEN BEGIN CYC←-1; GO TO BEFORE; END;
14600		IF ABS(SIN(TH_AVE))>0.5 THEN
14700		BEGIN "CASE_A"
14800			CPRIME←(SUMX*SUMXY-SUMY*SUMXSQ)/(SUMN*SUMXSQ-SUMX*SUMX);
14900			THETA←ATAN(-SUMXSQ/(CPRIME*SUMX+SUMXY));
15000	⊃ OUTSTR(CRLF&"THETA="&CVG(THETA));
15100			J←1.2*(TH_AVE-THETA)/PI1+.1;
15200			TH_LS←THETA+J*PI1;
15300			IF ABS(TH_AVE-TH_LS)>NDTH2 THEN
15400			BEGIN TH_LS←TH_AVE; CPRIME←C_AVE/SIN(TH_AVE); END;
15500			SINTH←SIN(TH_LS); COSTH←COS(TH_LS);
15600			C_LS←CPRIME*SINTH;
15700			GO TO LAST1;
15800		END "CASE_A"
15900	
16000		ELSE
16100		BEGIN "CASE_B"
16200			CPRIME←(SUMY*SUMXY-SUMX*SUMYSQ)/(SUMN*SUMYSQ-SUMY*SUMY);
16300			THETA←ATAN(-(CPRIME*SUMY+SUMXY)/SUMYSQ);
16400	⊃ OUTSTR(CRLF&"THETA="&CVG(THETA));
16500			J←1.2*(TH_AVE-THETA)/PI1+.1;
16600			TH_LS←THETA+J*PI1;
16700			IF ABS(TH_AVE-TH_LS)>NDTH2 THEN
16800			BEGIN TH_LS←TH_AVE; CPRIME←C_AVE/COS(TH_AVE); END;
16900			SINTH←SIN(TH_LS); COSTH←COS(TH_LS);
17000			C_LS←CPRIME*COSTH;	
17100		END "CASE_B";
17200	
17300	LAST1:	SUM_RESID←0;
17400		FOR I←EBS STEP EBS UNTIL L_INDEX*EBS DO
17500		BEGIN
17600	      		RESID←(COSTH*LTEMP[I+POPX]+SINTH*LTEMP[I+POPY]+C_LS)↑2;
17700			SUM_RESID←SUM_RESID+RESID;
17800		END;
17900	      	CHI←SQRT(SUM_RESID/(SUMN-2));
18000	⊃ OUTSTR(CRLF&"TH_AVE="&CVG(TH_AVE)
18100	        &"   TH_LS="&CVG(TH_LS)
18200	        &"    C_LS="&CVG(C_LS)
18300	        &"    C_AVE="&CVG(C_AVE)
18400		&"    CHI="&CVG(CHI));
18500	       	IF CHI>NDCHI THEN GO TO POOR_LINE ELSE GO TO TLINE;
18600	POOR_LINE:	     
18700	⊃ SINCE THINGS ARE NOT WORKING OUT, WE TRY SPLITTING THE EDGE_POINTS
18800	  IN ORDER TO TAKE CARE OF CASE WHEN 2 LINES GIVE US A POOR TH_AVE
18900	  AND C_AVE;
19000		IF CYC=0∧(SUM_MINUS>NHIGH∨SUM_PLUS>NHIGH) THEN
19100		BEGIN
19200			IF DISP_POINTS THEN
19300			BEGIN
19400				DPYCLR;
19500				DPYSET(BUF);
19600				AIVECT(-300,420);
19700				DPYSST("BEFORE SPLIT");
19800				INIT_DOMAIN(X1,Y2,X2,Y1);
19900				BOUNDARY(X1,Y2,X2,Y1);
20000				EDGE_DISP(0,L_INDEX,X1,Y1,X2,Y2,LTEMP);
20100				DPYOUT(1);
20200				INCHWL;
20300				INCHWL;
20400				DPYCLR;
20500			END;
20600			CYC←-1;
20700			SPLIT(TH_AVE,C_AVE,SINTH,COSTH,LTEMP,SUMTH,SUMC,SUMN);
20800	⊃  OUTSTR(CRLF&"   IN SPLIT  ");
20900		     	TH_AVE←SUMTH/SUMN; C_AVE←SUMC/SUMN;
21000			GO TO BEFORE;
21100		END
21200		ELSE
21300		BEGIN
21400	IF DISP_POINTS THEN BEGIN "QUESTION" OUTSTR(CRLF&"THIS IS A POOR FIT --
21500		 ONLY  "&CVS(SUMN)&"  GOOD POINTS. CHI = "&CVG(CHI)&"
21600				DO YOU WANT TO SEE THE EDGES -- Y OR N?");
21700			PTEST ←	INCHWL;
21800			IF EQU(PTEST,"Y") THEN
21900			BEGIN
22000				DPYCLR;
22100				DPYSET(BUF);
22200				INIT_DOMAIN(X1,Y2,X2,Y1);
22300				BOUNDARY(X1,Y2,X2,Y1);
22400				EDGE_DISP(0,L_INDEX,X1,Y1,X2,Y2,LTEMP);
22500				DPYOUT(1);
22600				INCHWL;
22700				INCHWL;
22800				DPYCLR;
22900			END; END "QUESTION";
23000	⊃ WE ARE GOING TO GET RID OF THIS LINE;
23100			RESMAX←-1000; CYC←1;
23200			HUMPS[N,2]←HUMPS[NHUMPS-1,2];
23300			HUMPS[N,1]←HUMPS[NHUMPS-1,1];
23400			NHUMPS←NHUMPS-1;
23500			GO TO AGAIN2;
23600		END;
23700	TLINE:	IF ¬DISP_POINTS THEN GO TO LAST2;
23800		DPYCLR;
23900		DPYSET(BUF);
24000		AIVECT(-300,420);
24100		DPYSST("CHI="&CVG(CHI)&"  NO. OF POINTS="&CVG(SUMN));
24200		EDGE_DISP(0,L_INDEX,X1,Y1,X2,Y2,LTEMP);
24300	        DPYOUT(1);
24400		INCHWL;
24500		INCHWL;
24600	LAST2:	DEN←ABS(SINTH);     GAP1_FOUND←0;
24700		IF DEN>0.5 THEN TESTXY←POPX 
24800		ELSE BEGIN TESTXY←POPY; DEN←ABS(COSTH); END;
24900		LOWEST← EBS;
25000	AGAIN3:	MIN←1000; 
25100		FOR I←LOWEST STEP EBS UNTIL INDEX DO
25200		IF LTEMP[I+TESTXY]<MIN THEN 
25300		BEGIN ISAVE←I;  MIN←LTEMP[I+TESTXY]; END;
25400		IF ISAVE≠LOWEST THEN
25500		FOR J←POPX STEP 1 UNTIL POPX+EBS-1 DO
25600		BEGIN
25700			TEMP←LTEMP[ISAVE+J];
25800			LTEMP[ISAVE+J]←LTEMP[LOWEST+J];
25900			LTEMP[LOWEST+J]←TEMP;
26000		END;
26100	  		LOWEST←LOWEST+EBS;
26200		IF LOWEST≠INDEX THEN GO TO AGAIN3;
26300	AGAIN4:	GAP2_FOUND←0; MEAN←(L_INDEX DIV 2)*EBS; 
26400		MG_LENGTH←NDGAP*(LTEMP[INDEX+TESTXY]-LTEMP[EBS+TESTXY])/DEN;
26500	⊃ OUTSTR(CRLF&"INDEX="&CVS(INDEX)
26600	           &"    MEAN="&CVS(MEAN)
26700	           &"    MG_LENGTH="&CVS(MG_LENGTH));
26800	⊃ OUTSTR(CRLF&" X="&CVG(LTEMP[EBS+POPX])&"  Y="&CVG(LTEMP[EBS+POPY]));
26900	⊃ OUTSTR(CRLF&" X="&CVG(LTEMP[INDEX+POPX])&"  Y="&CVG(LTEMP[INDEX+POPY]));
27000		F_INDEX←INDEX;
27100		IF (LTEMP[TESTXY+2*EBS]-LTEMP[TESTXY+EBS])/DEN>NDS THEN
27200			LTEMP[TESTXY+EBS]←-100;
27300		IF (LTEMP[TESTXY+F_INDEX]-LTEMP[TESTXY+F_INDEX-EBS])/DEN>NDS THEN
27400			LTEMP[TESTXY+F_INDEX]←2000;
27500		FOR J←EBS STEP EBS UNTIL F_INDEX-EBS DO	
27600		BEGIN
27700			GAP←(LTEMP[J+TESTXY+EBS]-LTEMP[J+TESTXY])/DEN;
27800			IF GAP>NDS3∨GAP>MG_LENGTH THEN
27900			BEGIN "ELIMINATE"
28000			GAP1_FOUND←GAP2_FOUND←-1; 
28100	IF DISP_POINTS THEN OUTSTR(CRLF&"GAP FOUND  N="&CVS(N)
28200		&"  GAP="&CVG(GAP)&"  MG_LENGTH="&CVG(MG_LENGTH));
28300			IF J<MEAN THEN
28400			BEGIN "FIRST"
28500				FOR I←EBS STEP EBS UNTIL J DO
28600				BEGIN
28700	⊃ NOW WE PUT THE BAD-FIT EDGE POINTS BACK IN ARRAY EDGES;
28800					EDGE_INDEX ← EDGE_INDEX +1;
28900					EI ← EDGE_INDEX*EDGE_BLSIZE;
29000					EDGES[EI+PTH] ← LTEMP[I+PTH];
29100					EDGES[EI+PC] ← LTEMP[I+PC];
29200					EDGES[EI+POPX] ← LTEMP[I+POPX];
29300					EDGES[EI+POPY] ← LTEMP[I+POPY];
29400					L_INDEX ← L_INDEX -1;
29500					INDEX ← INDEX -EDGE_BLSIZE;
29600				END;
29700				K←0;
29800				FOR I←J+EBS STEP EBS UNTIL F_INDEX DO
29900				BEGIN
30000					K←K+EBS;
30100					LTEMP[K+PTH]←LTEMP[I+PTH];
30200					LTEMP[K+PC]←LTEMP[I+PC];
30300					LTEMP[K+POPX]←LTEMP[I+POPX];
30400					LTEMP[K+POPY]←LTEMP[I+POPY];
30500				END;
30600			END "FIRST"
30700			ELSE
30800			FOR I←J+EBS STEP EBS UNTIL F_INDEX DO
30900			BEGIN
31000	⊃ NOW WE PUT THE BAD-FIT EDGE POINTS BACK IN ARRAY EDGES;
31100				EDGE_INDEX ← EDGE_INDEX +1;
31200				EI ← EDGE_INDEX*EDGE_BLSIZE;
31300				EDGES[EI+PTH] ← LTEMP[I+PTH];
31400				EDGES[EI+PC] ← LTEMP[I+PC];
31500				EDGES[EI+POPX] ← LTEMP[I+POPX];
31600		 		EDGES[EI+POPY] ← LTEMP[I+POPY];
31700				L_INDEX ← L_INDEX -1;
31800				INDEX ← INDEX -EDGE_BLSIZE;
31900			END;
32000			IF L_INDEX ≤ NHIGH THEN GO TO POOR_LINE;
32100			GO TO AGAIN4;
32200			END "ELIMINATE";
32300		END;
32400		IF L_INDEX≤NHIGH THEN GO TO POOR_LINE;
32500		IF GAP1_FOUND THEN BEGIN CYC←-1; GO TO BEFORE; END;
32600	⊃ OUTSTR(CRLF&" NO GAPS FOUND THIS CYCLE");
32700		FOR I←EBS STEP EBS UNTIL INDEX DO
32800		BEGIN
32900	⊃ NOW WE STORE THE GOOD-FIT EDGE POINTS IN ARRAY LINES;
33000		    		LINEPTS(LINE_INDEX+POPX) ← LTEMP[I+POPX];
33100		    		LINEPTS(LINE_INDEX+POPY) ← LTEMP[I+POPY];
33200		    		LINEPTS(LINE_INDEX+PC) ← LTEMP[I+PC];
33300		    		LINEPTS(LINE_INDEX+PTH) ← LTEMP[I+PTH];
33400				LINE_INDEX ← LINE_INDEX + EDGE_BLSIZE;
33500		END;
33600	⊃ FILLING ARRAY HUMPS;
33700		HUMPS[N,THET] ← TH_LS;
33800		HUMPS[N,CEE] ← C_LS;
33900		HUMPS[N,4] ← LINE_INDEX-EBS;
34000		HUMPS[N,CHIVALUE] ← CHI;
34100		HUMPS[N,8]←SUMN;
34200		HUMPS[N,SINTHETA]←SINTH;
34300		HUMPS[N,COSTHETA]←COSTH;
34400		RETURN(-1);
34500	END "LINETEST";
34600	
     

00100	
00200	
00300	BOOLEAN PROCEDURE LINER;
00400	
00500	⊃ HERE THE EDGE-POINTS ARE SEPARATED INTO A GROUP FOR EACH LINE;
00600	
00700	BEGIN "LINER"
00800	SHORT INTEGER N,I;
00900	SHORT REAL TH_AVE,C_AVE,TEMP;
01000	LABEL BEF1,LAST;
01100	SHORT REAL ARRAY LTEMP[1:LT_LIMIT];
01200	
01300	IF NHUMPS=MINHUMPS THEN RETURN(0);
01400	FOR N←MINHUMPS STEP 1 UNTIL NHUMPS-1 DO
01500	BEGIN
01600	⊃ FILLING ARRAY HUMPS; HUMPS[N,3]←LINE_INDEX;
01700		INDEX ← EDGE_BLSIZE;
01800	⊃ HERE WE TAKE ALL EDGE_POINTS INSIDE A LARGE REGION (4NDTH*4NDC)
01900	  AND STORE THEM IN ARRAY LTEMP;
02000		FOR I←EDGE_BLSIZE STEP EDGE_BLSIZE UNTIL EDGE_INDEX*EDGE_BLSIZE DO
02100		BEGIN "LGET"
02200		TEMP←ABS(EDGES[I+PTH]-HUMPS[N,1]);
02300		IF ABS(EDGES[I+PC]-HUMPS[N,2])<NDC2
02400			∧(TEMP<NDTH2∨ABS(TEMP-PIT2)<NDTH2) THEN
02500		BEGIN
02600			LTEMP[INDEX+PTH] ← EDGES[I+PTH];
02700			LTEMP[INDEX+PC] ← EDGES[I+PC];
02800			LTEMP[INDEX+POPX] ← EDGES[I+POPX];
02900	  		LTEMP[INDEX+POPY] ← EDGES[I+POPY];
03000			EI ← EDGE_INDEX*EDGE_BLSIZE;
03100	     		EDGES[I+POPX] ← EDGES[EI+POPX];
03200	     		EDGES[I+POPY] ← EDGES[EI+POPY];
03300	     		EDGES[I+PC] ← EDGES[EI+PC];
03400	     		EDGES[I+PTH] ← EDGES[EI+PTH];
03500			EDGE_INDEX ← EDGE_INDEX -1;
03600			INDEX ← INDEX + EDGE_BLSIZE;
03700			I ← I - EDGE_BLSIZE;
03800		END;
03900		IF INDEX≥LT_LIMIT THEN GO TO BEF1;
04000		END "LGET";
04100	BEF1:	TH_AVE←HUMPS[N,1]; C_AVE←HUMPS[N,2];
04200		IF ¬LINETEST(N,TH_AVE,C_AVE,NDTH,NDC,LTEMP) THEN
04300		BEGIN
04400			N←N-1;
04500			GO TO LAST;
04600		END;
04700	   IF FLAG≠0 THEN GO TO LAST;
04800	IF ¬DISP_POINTS THEN GO TO LAST;
04900		DPYSET(BUF);
05000		LINE_FIND(EDGE_INDEX,EDGES);
05100		POINTER(TH_AVE,NDTH,C_AVE,NDC);
05200		LINE_FIND(L_INDEX,LTEMP);
05300		AIVECT(-300,420);
05400		DPYSST("TH_AVE="&CVG(TH_AVE)&"    C_AVE="&CVG(C_AVE));
05500		DPYOUT(1);
05600		INCHWL;
05700		INCHWL;
05800		DPYCLR;
05900		DPYSET(BUF);
06000		AIVECT(-300,420);
06100		DPYSST("CHI="&CVG(HUMPS[N,7])&"  NO. OF POINTS="&CVS(HUMPS[N,8]));
06200		INIT_DOMAIN(X1,Y2,X2,Y1);
06300		BOUNDARY(X1,Y2,X2,Y1);
06400		EDGE_DISP(0,L_INDEX,X1,Y1,X2,Y2,LTEMP);
06500	        DPYOUT(1);
06600		INCHWL;
06700		LEDGE_INDEX ← LINE_INDEX DIV EDGE_BLSIZE;
06800		INIT_DOMAIN(X1,Y2,X2,Y1);
06900		BOUNDARY(X1,Y2,X2,Y1);
07000		EDGE_DISP(-1,LEDGE_INDEX,X1,Y1,X2,Y2,EDGES);
07100		⊃ THIS WILL RESULT IN A DISPLAY OF THE LINE EDGE_POINTS;
07200	        DPYOUT(1);
07300		INCHWL;
07400		INCHWL;
07500		DPYCLR;
07600	LAST:
07700	END;
07800	IF NHUMPS=MINHUMPS THEN RETURN(0);
07900	MINHUMPS ← NHUMPS;
08000	RETURN(-1);
08100	END "LINER";
08200	
08300	
     

00100	
00200	
00300	PROCEDURE CONNECT(INTEGER N);
00400	BEGIN "CONNECT"
00500	SHORT INTEGER I,J,INDEX1,INDEX2, ISAVE,TESTXY,JHUMP;
00600	SHORT INTEGER TEMP,LOWEST;
00700	SHORT REAL THETA, C,SINTH,COSTH,MIN,DEN,GAP;
00800	BOOLEAN SOLID;
00900	LABEL AGAIN, NEXT,OMIT;
01000		THETA←HUMPS[N,1];
01100		C←HUMPS[N,2];
01200		INDEX1←HUMPS[N,3]; ⊃ STARTING LOCATION OF EDGES IN ARRAY LINES;
01300		INDEX2←HUMPS[N,4]; ⊃ ENDING LOCATION OF EDGES IN ARRAY LINES;
01400		HUMPS[N,3]←-1;
01500		HUMPS[N,4]←-1;
01600		HUMPS[N,13]←HUMPS[N,14]←-1;
01700		HUMPS[N,15]←HUMPS[N,16]←-1;
01800	  	SINTH←SIN(THETA); COSTH←COS(THETA);
01900		DEN←ABS(SINTH);
02000		IF DEN>0.5 THEN TESTXY←POPX 
02100		ELSE BEGIN TESTXY←POPY; DEN←ABS(COSTH); END;
02200		SOLID←-1; JHUMP←FPOINT+3;
02300		FOR I←INDEX1 STEP EBS UNTIL INDEX2 DO
02400		BEGIN
02500			GAP←(LINEPTS(I+TESTXY+EBS)-LINEPTS(I+TESTXY))/DEN;
02600			IF GAP<NDS THEN 
02700			BEGIN
02800				HUMPS[N,FPOINT+1]← LINEPTS(I+POPX);
02900				HUMPS[N,FPOINT+2]← LINEPTS(I+POPY);
03000				LOWEST←I+EBS;
03100				GO TO NEXT;
03200			END;
03300		END;
03400	NEXT: 	IF I≥ INDEX2-2*EBS THEN GO TO OMIT;
03500		ISAVE←1;
03600		FOR I←LOWEST STEP EBS UNTIL INDEX2 DO
03700		BEGIN
03800			GAP←(LINEPTS(I+TESTXY+EBS)-LINEPTS(I+TESTXY))/DEN;
03900			IF (SOLID∧GAP<NDS32)∨(¬SOLID∧GAP>NDS32) THEN CONTINUE;
04000			HUMPS[N,JHUMP]← SOLID;
04100			HUMPS[N,JHUMP+1]← LINEPTS(I+POPX);
04200			HUMPS[N,JHUMP+2]← LINEPTS(I+POPY);
04300			JHUMP←JHUMP+3;
04400			SOLID←¬SOLID;
04500			ISAVE←ISAVE+1;
04600		END;
04700	⊃ TO END THE LINE WE DO THE FOLLOWING;
04800		IF SOLID THEN
04900		BEGIN
05000			HUMPS[N,JHUMP]← SOLID;
05100			HUMPS[N,JHUMP+1]← LINEPTS(INDEX2+POPX);
05200			HUMPS[N,JHUMP+2]← LINEPTS(INDEX2+POPY);
05300			ISAVE←ISAVE+1;
05400		END;
05500	⊃ IF NOT SOLID THEN WE SHALL LEAVE THE END AS THE LAST SOLID POINT;
05600	⊃ FILLING ARRAY HUMPS;
05700		HUMPS[N,5]←ISAVE; ⊃ THIS IS THE NUMBER OF POINTS
05800				    ALONG THE LINE;
05900		HUMPS[N,6]←FPOINT+3*(ISAVE-1); ⊃ THIS IS LOCATION JUST
06000			BEFORE X-LOCATION OF LAST POINT;
06100		HUMPS[N,SIGNX]←SIGN(HUMPS[N,HUMPS[N,6]+1]-HUMPS[N,FPOINT+1]);
06200		HUMPS[N,SIGNY]←SIGN(HUMPS[N,HUMPS[N,6]+2]-HUMPS[N,FPOINT+2]);
06300		⊃ THESE ARE +1 OR -1 DEPENDING UPON WHETHER X OR Y 
06400			IS INCREASING OR DECREASING;
06500	⊃	FOR I←INDEX1 STEP EBS UNTIL INDEX2 DO
06600	 	OUTSTR(CRLF&" X="&CVG(LINEPTS(I+POPX))
06700		       &"     Y="&CVG(LINEPTS(I+POPY)));
06800	JHUMP←JHUMP+3;
06900	⊃ FOR I←1 STEP 1 UNTIL JHUMP DO
07000	OUTSTR(CRLF&"  HUMPS -- I="&CVS(I)&"  "&CVG(HUMPS[N,I]));
07100	   IF ¬DISP_POINTS THEN GO TO OMIT;
07200		DPYSET(BUF);
07300		BOUNDARY(X1,Y2,X2,Y1);
07400		LINE_DISP(N);
07500		DPYOUT(1);
07600		INCHWL;
07700		INCHWL;
07800	OMIT:
07900	END "CONNECT";
08000	
08100	
08200	
     

00100	
00200	
00300	
00400	PROCEDURE FORM_ONE_LINE(INTEGER N,J);
00500	BEGIN "FORM"
00600	SHORT INTEGER F,L,I,JHUMP,ISAVE,LASTPT;
00700	SHORT REAL D1,D2,ABSINTH;
00800	BOOLEAN TEST2,SOLID;
00900	LABEL FORM0,FORM2,FIRSTN,FIRSTJ,NEXT,ORD;
01000	⊃  OUTSTR(CRLF&"  IN FORM  ");
01100		TEST2←0;
01200		IF N=J THEN
01300		BEGIN
01400			OUTSTR(CRLF&" SAME LINE  N="&CVS(N)&"  J="&CVS(J));
01500			RETURN;
01600		END;
01700	⊃ WE COMPARE THE FIRST END OF LINE N WITH THE FIRST
01800		END OF THE LINE J;
01900		IF HUMPS[N,13]>0 THEN GO TO FIRSTN;
02000		IF HUMPS[J,13]>0 THEN GO TO FIRSTJ;
02100		ABSINTH←ABS(HUMPS[N,SINTHETA]);
02200		IF ABSINTH>0.5 THEN
02300		BEGIN
02400			D1←HUMPS[J,FPOINT+1];
02500			D2←HUMPS[N,FPOINT+1];
02600		END ELSE
02700		BEGIN
02800			D1←HUMPS[J,FPOINT+2];
02900	 		D2←HUMPS[N,FPOINT+2];
03000		END;
03100	⊃ OUTSTR(CRLF&" D1="&CVG(D1)&"   D2="&CVG(D2));
03200		IF D1<D2 THEN GO TO FIRSTJ;
03300	FIRSTN:	BEGIN 
03400			F←N; L←J; 
03500			GO TO NEXT;
03600		END;          
03700	FIRSTJ:	BEGIN 
03800			F←J; L←N;      
03900		END;
04000	NEXT:
04100	IF DISP_VERT THEN OUTSTR(CRLF&" FIRST LINE="&CVS(F)
04200		&"  SECOND LINE="&CVS(L));
04300	⊃  FOR I←1 STEP 1 UNTIL HUMPS[F,6]+4 DO
04400	OUTSTR(CRLF&"  I="&CVS(I)&"  HUMPS[F,I]="&CVG(HUMPS[F,I]));
04500	⊃  FOR I←1 STEP 1 UNTIL HUMPS[L,6]+4 DO
04600	OUTSTR(CRLF&"  I="&CVS(I)&"  HUMPS[L,I]="&CVG(HUMPS[L,I]));
04700		IF HUMPS[L,15]>0 THEN
04800		BEGIN
04900			HUMPS[F,15]←HUMPS[L,15];
05000			HUMPS[F,16]←HUMPS[L,16];
05100			HUMPS[F,4]←HUMPS[L,4];
05200		END;
05300		IF HUMPS[L,7]/(HUMPS[L,8]-3)<HUMPS[F,7]/(HUMPS[F,8]-3) THEN
05400		BEGIN
05500			HUMPS[F,1]←HUMPS[L,1];
05600			HUMPS[F,2]←HUMPS[L,2];
05700			HUMPS[F,7]←HUMPS[L,7];
05800			HUMPS[F,9]←HUMPS[L,9];
05900			HUMPS[F,10]←HUMPS[L,10];
06000		END;
06100		HUMPS[F,8]←HUMPS[F,8]+HUMPS[L,8];
06200		SOLID←-1;
06300		JHUMP←HUMPS[F,6]+3;
06400		IF JHUMP+HUMPS[L,6]-FPOINT+2≥HUMP_LIMIT THEN
06500		BEGIN
06600			FOR I←1,2 DO
06700			HUMPS[F,HUMPS[F,6]+I]←HUMPS[L,HUMPS[L,6]+I];
06800			GO TO ORD;
06900		END;
07000		HUMPS[F,5]←HUMPS[F,5]+HUMPS[L,5];
07100		HUMPS[F,JHUMP]←SOLID;
07200		JHUMP←JHUMP-FPOINT;
07300		LASTPT←HUMPS[L,6]+2;
07400		HUMPS[F,6]←JHUMP+LASTPT-2;
07500	⊃  OUTSTR(CRLF&"JHUMP="&CVS(JHUMP)&"  LASTPT="&CVS(LASTPT));
07600	⊃ OUTSTR(CRLF&"LAST X OF L="&CVG(HUMPS[L,HUMPS[L,6]+1]));
07700		FOR I←FPOINT+1 STEP 1 UNTIL LASTPT DO	
07800		HUMPS[F,I+JHUMP]←HUMPS[L,I];
07900	⊃ OUTSTR(CRLF&"LAST X OF F="&CVG(HUMPS[F,HUMPS[F,6]+1]));
08000	ORD:	ORDER(F);
08100	⊃  FOR I←1 STEP 1 UNTIL HUMPS[F,6]+4 DO
08200	OUTSTR(CRLF&"  I="&CVS(I)&"  HUMPS[F,I]="&CVG(HUMPS[F,I]));
08300	FORM0:	FOR J←1 STEP 1 UNTIL NVERT DO
08400		FOR I←4 STEP 1 UNTIL VERTEX[J,3]+4 DO
08500	 	IF VERTEX[J,I]=L THEN	VERTEX[J,I]←F;
08600	FORM2:	IF TEST2 THEN RETURN; 
08700		JHUMP←HUMPS[NHUMPS-1,6]+2;
08800		FOR I←1 STEP 1 UNTIL JHUMP DO
08900		HUMPS[L,I]←HUMPS[NHUMPS-1,I];
09000		NHUMPS←NHUMPS-1;
09100		F←L; L←NHUMPS; TEST2←-1; 
09200	⊃  OUTSTR(CRLF&"  TEST = TRUE  ");
09300		GO TO FORM0;
09400	END "FORM";
09500	
     

00100	
00200	
00300	BOOLEAN PROCEDURE TEST_ONE_LINE(SHORT INTEGER N,J;
00400		REFERENCE REAL X,Y);
00500	BEGIN "TES"
00600	
00700	DEFINE LENGSQ="25."; ⊃ LINES OF LENGTH ≤ SQRT(LENGSQ) ARE CONSIDERED TO
00800		BE SHORT LINES AND THEREFORE ARE GIVEN GREATER
00900		ANGULAR TOLERANCE IN JOINING WITH OTHER LINES;
01000	DEFINE LONGSQ={100.}; ⊃ Lines of length longer than 10 are not joined;
01100	
01200	SHORT REAL DIFF,LENGNSQ,LENGJSQ;
01300	LABEL INT;
01400	
01500	LENGNSQ←LENGTHSQ(N);
01600	LENGJSQ←LENGTHSQ(J);
01700	IF LENGNSQ>LONGSQ∧LENGJSQ>LONGSQ THEN GO TO INT;
01800	 IF (DIFF←ABS(HUMPS[J,THET]-HUMPS[N,THET]))<NDANG∨ABS(DIFF-PIT2)<NDANG
01900	   ∨((LENGNSQ<LENGSQ∨LENGJSQ<LENGSQ)
02000			∧(DIFF<2*NDANG∨ABS(DIFF-PIT2)<2*NDANG)) THEN
02100				BEGIN
02200					FORM_ONE_LINE(N,J);
02300					RETURN (-1);	
02400				END;        
02500	INT:		 	INTERSECT(N,J);
02600				RETURN(0);
02700	
02800	⊃ OUTSTR(CRLF&" X="&CVG(X)&"  Y="&CVG(Y)&"  XC="&CVG(XC)&"   YC="&CVG(YC));
02900	END "TES";
03000	
03100	
     

00100	
00200	
00300	
00400	
00500	
00600	BOOLEAN PROCEDURE EXT_ONE(SHORT INTEGER N;BOOLEAN WHICHEND);
00700	
00800	⊃ Here we extend one end of one line;
00900	
01000	BEGIN "EXT_ONE"
01100	SHORT INTEGER I,J,K,J1,J2,NUM_VERT,XEND,YEND,WHICH_END,VER_END;
01200	SHORT INTEGER XLOC,YLOC,VEND,SIGX,SIGY,VSAVE;
01300	SHORT REAL DBOUND,XC,YC,DVERT,DENDS,DENDS1,DENDS2,X,Y,LSQ;
01400	SHORT REAL D1,D2,XNJ1,YNJ1,DX,DY,VERT_GAP;
01500	SHORT REAL ARRAY ENDSAVE[1:10,1:4];
01600	LABEL LOOK1,LOOK2,LOOK3,LOOK4,LAST,AFT1,AFT2;
01700	LABEL LOOK5,LOOK6,FIRST,SECOND,PRIN,VERY_END,CONECT;
01800	
01900		IF WHICHEND THEN 
02000		BEGIN
02100			XLOC←FPOINT+1;
02200			YLOC←FPOINT+2;
02300			VEND←3;
02400			XEND←13;
02500			YEND←14;
02600			SIGX←-HUMPS[N,SIGNX];
02700			SIGY←-HUMPS[N,SIGNY];
02800		END ELSE 
02900		BEGIN
03000			XLOC←HUMPS[N,6]+1;
03100			YLOC←HUMPS[N,6]+2;
03200			XEND←15;
03300			YEND←16;
03400			VEND←4;
03500			SIGX←HUMPS[N,SIGNX];
03600			SIGY←HUMPS[N,SIGNY];
03700		END;
03800		   HUMPS[N,DIRSIN]←SIGX*ABS(HUMPS[N,SINTHETA]);
03900	           HUMPS[N,DIRCOS]←SIGY*ABS(HUMPS[N,COSTHETA]);
04000	LOOK1: 	NUM_VERT←0; 
04100		XC←HUMPS[N,XLOC]+0.95*NDRAD*HUMPS[N,DIRSIN];
04200	      	YC←HUMPS[N,YLOC]+0.95*NDRAD*HUMPS[N,DIRCOS];
04300	
04400	⊃ OUTSTR(CRLF&"  NOW WORKING ON LINE "&CVS(N));
04500		
04600	
04700		IF NVERT=0 THEN GO TO LOOK2;
04800		FOR J←1 STEP 1 UNTIL NVERT DO
04900		IF (DVERT←(VERTEX[J,1]-XC)↑2+(VERTEX[J,2]-YC)↑2)
05000		<NDRSQ THEN
05100	       	BEGIN
05200			NUM_VERT←NUM_VERT+1;
05300			VSAVE←J;
05400		END;
05500	LOOK2: ⊃ OUTSTR(CRLF&" NUMBER OF VERTICES = "&CVS(NUM_VERT));
05600		I←0;
05700	      	FOR J←0 STEP 1 UNTIL NHUMPS-1 DO
05800	⊃ HERE WE FIND THE NUMBER OF UNENDED LINES INSIDE THE CIRCLE AND 
05900		SET IT TO "I";
06000		BEGIN
06100			IF J=N THEN CONTINUE;
06200			IF HUMPS[J,13]>0 THEN DENDS1←1000 ELSE
06300			DENDS1←(HUMPS[J,FPOINT+1]-XC)↑2
06400			+(HUMPS[J,FPOINT+2]-YC)↑2;
06500			IF HUMPS[J,15]>0 THEN DENDS2←1000 ELSE
06600			DENDS2←(HUMPS[J,HUMPS[J,6]+1]-XC)↑2
06700			+(HUMPS[J,HUMPS[J,6]+2]-YC)↑2;
06800			DENDS←SMALLER(DENDS1,DENDS2);
06900			IF DENDS<NDRSQ THEN
07000			BEGIN
07100				I←I+1;
07200				ENDSAVE[I,1]←J; ⊃ LINE NUMBER;
07300				ENDSAVE[I,2]←DENDS;
07400				IF DENDS1<DENDS2 THEN BEGIN ENDSAVE[I,3]←13;
07500							ENDSAVE[I,4]←3; END
07600				ELSE BEGIN ENDSAVE[I,3]←15; ENDSAVE[I,4]←4; END;
07700			END;
07800	⊃  ENDSAVE[I,3] STORES THE XEND NUMBER;
07900	⊃  ENDSAVE[I,4] STORES THE VEND NUMBER;
08000		END;
08100	       	IF DISP_VERT THEN OUTSTR(CRLF&" NUMBER OF LINES = "&CVS(I)
08200			&", VERTICES="&CVS(NUM_VERT));
08300		IF NUM_VERT=0∧I=0 THEN GO TO LOOK5 
08400		ELSE IF DIS_EYE THEN SHOWCIR(XC,YC,NDRAD);
08500		IF NUM_VERT=0∧I=1 THEN
08600	⊃ THIS IS THE CASE OF TWO LINES INTERSECTING;
08700	LOOK3:	BEGIN
08800	⊃   OUTSTR(CRLF"  IN LOOK3  ");
08900			J←ENDSAVE[1,1];  DENDS←ENDSAVE[1,2];
09000			WHICH_END←ENDSAVE[1,3];  VER_END←ENDSAVE[1,4];
09100			DX←HUMPS[J,SIGNX]*ABS(HUMPS[J,SINTHETA]);
09200			DY←HUMPS[J,SIGNY]*ABS(HUMPS[J,COSTHETA]);
09300			IF WHICH_END=13 THEN 
09400			BEGIN DX←-DX; DY←-DY; END;
09500			HUMPS[J,DIRSIN]←DX;
09600			HUMPS[J,DIRCOS]←DY;
09700			IF TEST_ONE_LINE(N,J,X,Y) THEN RETURN(-1);
09800			IF (X-XC)↑2+(Y-YC)↑2<NDRSQ THEN            
09900			BEGIN
10000				HUMPS[N,XEND]←HUMPS[J,WHICH_END]←X;
10100				HUMPS[N,YEND]←HUMPS[J,WHICH_END+1]←Y;   
10200				HUMPS[N,VEND]←HUMPS[J,VER_END]←NVERT+1;
10300				VERTEX[NVERT+1,3]←2;
10400				GO TO AFT2;
10500			END;
10600			RETURN(0);
10700		END;
10800		IF NUM_VERT=0∧I=2 THEN
10900	⊃ THIS IS THE CASE OF THREE LINES WHICH MAY INTERSECT IN ONE POINT;
11000	LOOK4:	 BEGIN "FOUR"
11100			J1←ENDSAVE[1,1];
11200			J2←ENDSAVE[2,1];
11300			IF VERT_THREE(N,J1,J2,X,Y,VERT_GAP) THEN GO TO AFT1;
11400			FOR J←J1,J2 DO
11500			IF TEST_ONE_LINE(N,J,X,Y) THEN RETURN(-1);
11600			RETURN(0);
11700		END "FOUR";
11800	LOOK5:	IF NUM_VERT=0∧I=0 THEN
11900	⊃ HERE WE LOOK FOR THE POSSIBILITY OF THIS LINE INTERCEPTING
12000	  A SOLID LINE WHICH HAS NO END POINT INSIDE THE CIRCLE;
12100		FOR J←0 STEP 1 UNTIL NHUMPS-1 DO
12200		BEGIN "LINE_PT"
12300			IF J=N THEN CONTINUE;
12400			IF ABS(XC*HUMPS[J,COSTHETA]+YC*HUMPS[J,SINTHETA]
12500			+HUMPS[J,CEE])>NDRAD THEN CONTINUE;
12600	⊃   OUTSTR(CRLF&"   IN LOOK5  ");
12700			X←HUMPS[J,FPOINT+1]; XNJ1←HUMPS[J,HUMPS[J,6]+1];
12800			Y←HUMPS[J,FPOINT+2]; YNJ1←HUMPS[J,HUMPS[J,6]+2];
12900			LSQ←(XNJ1-X)↑2+(YNJ1-Y)↑2;
13000			IF (X-XC)↑2+(Y-YC)↑2>LSQ∨(XNJ1-XC)↑2+(YNJ1-YC)↑2>LSQ
13100			THEN CONTINUE;
13200			IF DIS_EYE THEN SHOWCIR(XC,YC,NDRAD); 
13300				⊃ Display lines with circle;
13400	IF DISP_VERT THEN OUTSTR(CRLF&"  IN LOOK5:
13500		 LINE "&CVS(J)&" GOES THRU THE CIRCLE");
13600			IF TEST_ONE_LINE(N,J,X,Y) THEN RETURN(-1);
13700			IF (X-XC)↑2+(Y-YC)↑2>NDRSQ THEN RETURN(0);
13800			HUMPS[N,XEND]←X; HUMPS[N,YEND]←Y;
13900			HUMPS[N,VEND]←NVERT+1;
14000			VERTEX[NVERT+1,3]←2;
14100			GO TO AFT2;
14200		END "LINE_PT";
14300	LOOK6: 	IF NUM_VERT=1 THEN
14400	⊃ HERE WE ARE LOOKING TO SEE IF THIS LINE TERMINATES
14500		IN THIS ONE VERTEX;
14600		BEGIN
14700			IF VERTEX[VSAVE,3]=2 THEN
14800			BEGIN
14900				J1←VERTEX[VSAVE,4];
15000				J2←VERTEX[VSAVE,5];
15100				IF ¬VERT_THREE(N,J1,J2,X,Y,VERT_GAP) THEN RETURN(0);
15200				VERTEX[VSAVE,1]←X;
15300	         		VERTEX[VSAVE,2]←Y;
15400				VERTEX[VSAVE,VERTGAP]←VERT_GAP;
15500				FOR K←J1,J2 DO
15600			IF (X-HUMPS[K,FPOINT+1])↑2+(Y-HUMPS[K,FPOINT+2])↑2
15700	 	<(X-HUMPS[K,HUMPS[K,6]+1])↑2+(Y-HUMPS[K,HUMPS[K,6]+2])↑2 THEN
15800				BEGIN
15900					HUMPS[K,3]←VSAVE;
16000					HUMPS[K,13]←X;
16100					HUMPS[K,14]←Y;
16200				END ELSE
16300				BEGIN
16400					HUMPS[K,4]←VSAVE;
16500					HUMPS[K,15]←X;
16600					HUMPS[K,16]←Y;
16700				END;
16800				GO TO CONECT;
16900			END;
17000	⊃  OUTSTR(CRLF&"  IN LOOK6  ");
17100			IF ABS(VERTEX[VSAVE,1]*HUMPS[N,COSTHETA]
17200				+VERTEX[VSAVE,2]*HUMPS[N,SINTHETA]
17300				+HUMPS[N,CEE])>NDACC THEN RETURN(0);
17400	CONECT:		VERTEX[VSAVE,VERTEX[VSAVE,3]+4]←N;
17500			VERTEX[VSAVE,3]←VERTEX[VSAVE,3]+1;
17600			HUMPS[N,XEND]←VERTEX[VSAVE,1];
17700			HUMPS[N,YEND]←VERTEX[VSAVE,2];
17800			HUMPS[N,VEND]←VSAVE;
17900			IF DIS_EYE THEN SHOW;
18000		END;
18100		GO TO PRIN;
18200	AFT1:		HUMPS[N,XEND]←X;
18300			HUMPS[N,YEND]←Y;
18400			HUMPS[N,VEND]←NVERT+1;
18500	     		HUMPS[J1,ENDSAVE[1,3]]←X;
18600			HUMPS[J1,ENDSAVE[1,3]+1]←Y;
18700			HUMPS[J1,ENDSAVE[1,4]]←NVERT+1;
18800			HUMPS[J2,ENDSAVE[2,3]]←X;
18900			HUMPS[J2,ENDSAVE[2,3]+1]←Y;
19000			HUMPS[J2,ENDSAVE[2,4]]←NVERT+1;
19100			VERTEX[NVERT+1,3]←3;
19200			VERTEX[NVERT+1,6]←J2;
19300			VERTEX[NVERT+1,VERTGAP]←VERT_GAP;
19400			J←J1;
19500	AFT2:		NVERT←NVERT+1;
19600			VERTEX[NVERT,1]←X;
19700			VERTEX[NVERT,2]←Y;
19800			VERTEX[NVERT,4]←N;
19900			VERTEX[NVERT,5]←J;
20000			IF DIS_EYE THEN SHOW;
20100	PRIN: RETURN(0);
20200	END "EXT_ONE";
20300	
     

00100	
00200	PROCEDURE EXTEND;
00300	BEGIN "EXT"
00400	SHORT INTEGER N,K,J;
00500	BOOLEAN WHICHEND;
00600	LABEL FIRST,SECOND,FIR,AFTER,VVLAST;
00700	
00800	FIRST: 	NDRAD←NDRADIUS;
00900		NDRSQ←NDRAD*NDRAD;
01000		BIT_FACTOR←2↑(BITS-4); 
01100		NHUMPS←NLINES;  NVERT←NVERTEX;
01200	
01300	SECOND:  FOR N←0 STEP 1 UNTIL NHUMPS-1 DO
01400	BEGIN "CYCLE"
01500	FIR:	IF HUMPS[N,13]<0 THEN
01600		BEGIN
01700			WHICHEND←-1;
01800			IF EXT_ONE(N,WHICHEND) THEN GO TO AFTER;
01900		END;
02000		IF HUMPS[N,15]<0 THEN
02100		BEGIN
02200			WHICHEND←0;
02300			IF EXT_ONE(N,WHICHEND) THEN GO TO AFTER;
02400		END;
02500		CONTINUE;
02600	
02700	      	⊃  FOR K←0 STEP 1 UNTIL NHUMPS-1 DO
02800		OUTSTR(CRLF&" LINE  "&CVS(K)
02900				&" X1="&CVG(HUMPS[K,13])
03000	                   &" Y1="&CVG(HUMPS[K,14])
03100	                   &" X2="&CVG(HUMPS[K,15])
03200	                   &" Y2="&CVG(HUMPS[K,16]));
03300	⊃	FOR K←1 STEP 1 UNTIL NVERT DO
03400		OUTSTR(CRLF&"VERTEX  "&CVS(K)
03500				&"  XV="&CVG(VERTEX[K,1])
03600	                   &"  YV="&CVG(VERTEX[K,2])
03700	                   &"  NO. OF VERT.="&CVS(VERTEX[K,3])
03800	                   &"  V1="&CVS(VERTEX[K,4])
03900			   &"  V2="&CVS(VERTEX[K,5])
04000			   &"  V3="&CVS(VERTEX[K,6]));
04100	AFTER:		IF N=0 THEN GO TO FIR ELSE N←N-1;
04200	END "CYCLE";
04300		IF ¬DIS_EYE THEN GO TO VVLAST;
04400		DPYSET(BUF);
04500		AIVECT(-400,420);
04600	DPYSST("NUMBER OF LINES = "&CVS(NHUMPS)
04700		&",   NUMBER OF VERTICES = "&CVS(NVERT));
04800		BOUNDARY(X1,Y2,X2,Y1);
04900		FOR J←0 STEP 1 UNTIL NHUMPS-1 DO
05000		LINE_DISP(J);
05100		IF CAL_COMP THEN CALCOMP("EXTLIN",BUF);
05200		DPYOUT(1);
05300	VVLAST:  NLINES←NHUMPS;  NVERTEX←NVERT;
05400	END "EXT";
     

00100	
00200	PROCEDURE INITIAL;
00300	
00400	⊃ Here we set up and update initial parameters;
00500	
00600	BEGIN "INITIAL"
00700	SHORT INTEGER TEMP,I;
00800	SHORT REAL X,Y;
00900	LABEL OTHER;
01000		NHUMPS←MINHUMPS←NLINES; NVERT←NVERTEX; 
01100		LINE_INDEX ← EBS;
01200	
01300		IF NHUMPS≠0 THEN FOR I←0 STEP 1 UNTIL NHUMPS-1 DO
01400		BEGIN
01500			X←HUMPS[I,FPOINT+1]; Y←HUMPS[I,FPOINT+2];
01600			TEMP←-1;
01700	OTHER:		IF X<X1 THEN X1←X;
01800	      		IF X>X2 THEN X2←X;
01900			IF Y<Y1 THEN Y1←Y;
02000			IF Y>Y2 THEN Y2←Y;
02100			IF TEMP<0 THEN 
02200			BEGIN
02300				X←HUMPS[I,HUMPS[I,6]+1];
02400				Y←HUMPS[I,HUMPS[I,6]+2];
02500				TEMP←1;
02600				GO TO OTHER;
02700			END;
02800		END;
02900	
03000	
03100	⊃ PARAMETER FOR FINDING PEAKS IN THETA-C SPACE;
03200		NMIN ← 1; ⊃ NMIN SETS MINIMUM NUMBER OF POINTS FOR
03300			    PROGRAM TO LOOK FOR HISTOGRAM PEAK;
03400	
03500		NDTH2←2.*NDTH; NDC2←2.*NDC;
03600		NDS3←3*NDS; NDS32←1.5*NDS;  NHIGH_1←NHIGH-1;
03700		MAXR←200 DIV NDRES; IF MAXR>400 THEN MAXR←400;
03800		IF NDRES>1 THEN RHIGH←1 ELSE RHIGH←2;
03900		MAXDR←MAXR DIV 20;
04000		MINRES←MAXR DIV 10; MAXRES←MAXR-MINRES;
04100		THFACTOR←24.*(.15/NDTH);
04200		CFACTOR ← (50./DXY)*(22.5/NDC);
04300		MAXC←101*(22.5/NDC);
04400		MAXT←150*(.15/NDTH);
04500	END "INITIAL";
04600	
     

00100	
00200	
00300	PROCEDURE GET_LINES;
00400	
00500	BEGIN "GETL"
00600	SHORT INTEGER N,J;
00700	LABEL START,DL,VVLAST,CON;
00800	⊃ RECYCLE THRU THE EDGE_POINTS LOOKING FOR PEAKS UNTIL NO
00900	  NEW PEAKS ARE FOUND;
01000	
01100		INITIAL;
01200	START: 	NPEAKS←0;  IF ¬HIST_TH THEN GO TO DL;
01300		IF ¬HISTC THEN GO TO DL;
01400	IF LINER THEN GO TO START;
01500	DL:	LEDGE_INDEX ←LINE_INDEX DIV EDGE_BLSIZE;
01600		IF ¬DIS_EYE THEN GO TO CON;
01700		DPYSET(BUF);
01800		AIVECT(-300,420);
01900	DPYSST("NUMBER OF LINES FOUND = "&CVS(NHUMPS));
02000		INIT_DOMAIN(X1,Y2,X2,Y1);
02100		BOUNDARY(X1,Y2,X2,Y1);
02200		EDGE_DISP(-1,LEDGE_INDEX,X1,Y1,X2,Y2,EDGES);
02300		⊃ THIS WILL RESULT IN A DISPLAY OF THE LINE EDGE_POINTS;
02400		DPYOUT(1);
02500		IF CAL2_COMP THEN CALCOMP("NEWLEDG",BUF)
02600		ELSE IF CAL_COMP THEN CALCOMP("LINEDG",BUF);
02700	CON:	FOR N←NLINES STEP 1 UNTIL NHUMPS-1 DO
02800	     	CONNECT(N);
02900		IF ¬DIS_EYE THEN GO TO VVLAST;
03000		DPYSET(BUF);
03100		AIVECT(-300,420);
03200	DPYSST("NUMBER OF LINES FOUND = "&CVS(NHUMPS));
03300		BOUNDARY(X1,Y2,X2,Y1);
03400		FOR J←0 STEP 1 UNTIL NHUMPS-1 DO
03500		LINE_DISP(J);
03600		IF CAL2_COMP THEN CALCOMP("NEWLIN",BUF)
03700		ELSE IF CAL_COMP THEN CALCOMP("LINES",BUF);
03800		DPYOUT(1);
03900	VVLAST:	NLINES←NHUMPS; NVERTEX←NVERT;
04000	
04100	END "GETL";
04200	
     

00100	
00200	
00300	
00400	PROCEDURE GET_SOME_LINES(SHORT REAL ALPHA,DALPH);
00500	
00600	 ⊃ Here we accept lines with angles near ALPHA;
00700	
00800	
00900	BEGIN "GETS"
01000	SHORT INTEGER N,J;
01100	SHORT REAL ANG;
01200	LABEL VVLAST,CON;
01300	
01400		INITIAL;
01500	 	NPEAKS←0;  IF ¬HIST_TH THEN RETURN;
01600		FOR N←0 STEP 1 UNTIL NPEAKS-1 DO
01700		BEGIN
01800			ANG←ABS(PEAKS[N]-ALPHA);
01900			WHILE ANG>PIO2 DO
02000			ANG←ANG-PI1;
02100			IF ABS(ANG)>DALPH+.1 THEN
02200			BEGIN
02300				PEAKS[N]←PEAKS[NPEAKS-1];
02400				NPEAKS←NPEAKS-1;
02500				IF N≠NPEAKS THEN N←N-1;
02600			END;
02700		END;
02800		IF NPEAKS=0 THEN RETURN;
02900		IF ¬HISTC THEN RETURN;
03000		IF ¬LINER THEN RETURN;
03100		LEDGE_INDEX ←LINE_INDEX DIV EDGE_BLSIZE;
03200		IF ¬DIS_EYE THEN GO TO CON;
03300		DPYSET(BUF);
03400		AIVECT(-300,420);
03500	DPYSST("NUMBER OF NEW LINES FOUND = "&CVS(NHUMPS-NLINES));
03600		INIT_DOMAIN(X1,Y2,X2,Y1);
03700		BOUNDARY(X1,Y2,X2,Y1);
03800		EDGE_DISP(-1,LEDGE_INDEX,X1,Y1,X2,Y2,EDGES);
03900		⊃ THIS WILL RESULT IN A DISPLAY OF THE LINE EDGE_POINTS;
04000		DPYOUT(1);
04100	CON:	FOR N←NLINES STEP 1 UNTIL NHUMPS-1 DO
04200	     	CONNECT(N);
04300		IF ¬DIS_EYE THEN GO TO VVLAST;
04400		DPYSET(BUF);
04500		AIVECT(-300,420);
04600	DPYSST("NUMBER OF LINES FOUND = "&CVS(NHUMPS));
04700		BOUNDARY(X1,Y2,X2,Y1);
04800		FOR J←0 STEP 1 UNTIL NHUMPS-1 DO
04900		LINE_DISP(J);
05000		IF CAL2_COMP THEN CALCOMP("NEWLIN",BUF);
05100		DPYOUT(1);
05200	VVLAST:	NLINES←NHUMPS; NVERTEX←NVERT;
05300	
05400	END "GETS";
05500